https://github.com/bos/pool/issues/30

AsyncPool.hs

module AsyncPool where

import           Control.Concurrent          (threadDelay)
import           Control.Concurrent.Async    (async)
import           Control.Concurrent.MVar     (newMVar, withMVar)
import           Control.Concurrent.STM      (atomically)
import           Control.Concurrent.STM.TVar (newTVarIO, readTVar, writeTVar)
import           Control.Monad               (replicateM_, when)
import           Data.Pool

bad :: Int -- ^ Pool size
    -> Int -- ^ doSomething sleep time
    -> Int -- ^ Concurrent degree
    -> IO ()
bad poolSize sleepTime numThreads = do
  stdoutLock <- newMVar ()
  tvPool <- createPool (newTVarIO Free) (const $ pure ()) 1 1 poolSize
  replicateM_ numThreads $ withResource tvPool $ \tv -> async $ doSomething stdoutLock sleepTime tv

good :: Int -- ^ Pool size
     -> Int -- ^ doSomething sleep time
     -> Int -- ^ Concurrent degree
     -> IO ()
good poolSize sleepTime numThreads = do
  stdoutLock <- newMVar ()
  tvPool <- createPool (newTVarIO Free) (const $ pure ()) 1 1 poolSize
  replicateM_ numThreads $ async $ withResource tvPool $ \tv -> doSomething stdoutLock sleepTime tv

data ResourceState = Free | InUse deriving (Eq, Show)

doSomething stdoutLock sleepTime tv = do
  curr <- atomically $ readTVar tv
  if (curr == InUse)
    then do
      withMVar stdoutLock $ \_ -> putStrLn "Uh oh! Resource is in use D:"
    else do
      atomically $ writeTVar tv InUse
      withMVar stdoutLock $ \_ -> putStrLn "Safe use of resource :)"
      threadDelay sleepTime
      atomically $ writeTVar tv Free

{-
-- In the "bad" example, the resource is still in use when given to concurrent threads
λ: AsyncPool.bad 1 10000 5
Safe use of resource :)
Uh oh! Resource is in use D:
Uh oh! Resource is in use λ: D:
Uh oh! Resource is in use D:
Uh oh! Resource is in use D:

-- In the "good" example, each resource is always only in use by a single thread at a time
λ: AsyncPool.good 1 10000 5
Safe use of resource :)
λ: Safe use of resource :)
Safe use of resource :)
Safe use of resource :)
Safe use of resource :)

-}