pool.hs

module Actors where


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


type PoolQuery a b = a -> IO b
type PoolActor a = MVar (PoolQuery a ())


forkPoolActors :: (IO a) -> Int -> IO (PoolActor a)
forkPoolActors construct n = do
    qbox <- newEmptyMVar
    replicateM n $ do
        forkIO $ do
            res <- construct
            forever $ do
                query <- takeMVar qbox
                query res
        return ()
    return qbox


withResource :: PoolActor a -> PoolQuery a b -> IO b
withResource qbox query = do
    abox <- newEmptyMVar
    putMVar qbox $ \res -> query res >>= putMVar abox
    takeMVar abox