simple db pooling actor style

db.hs

module DB where


import Control.Concurrent.MVar
import Control.Concurrent (forkIO)
import Control.Monad (forever, replicateM)
import Database.PostgreSQL.Simple

type QueryFunc a = Connection -> IO a
type DBActor = MVar (QueryFunc ())


forkDBActors params n = do
    inbox <- newEmptyMVar
    replicateM n $ do
        forkIO $ do
            conn <- connectPostgreSQL params
            forever $ do
                query <- takeMVar inbox
                query conn
        return ()
    return inbox


withDB :: DBActor -> QueryFunc a -> IO a
withDB qbox query = do
    abox <- newEmptyMVar
    putMVar qbox $ \conn -> query conn >>= putMVar abox
    takeMVar abox