module Control.Concurrent.Bag.Task
  ( Task (..)
  , runTask
  , addTask )
where

import Control.Applicative
import Control.Monad.Reader
import Control.Concurrent.Bag.TaskBuffer
import qualified Control.Concurrent.Bag.Basic as Basic

-- | A monad in which tasks can be specified.
--   Task is instancing 'MonadIO' and it therefore has the function 'liftIO' to
--   perform arbitrary IO actions. Tasks may or may not return a value. If it
--   returns a value, this value is written back as a result.
--   Additionally there is a function 'addTask' to
--   add new tasks to the bag.
--   The parameter /r/ is the result type of the corresponding bag.
newtype Task b r a = Task { getTaskReader :: ReaderT (Basic.Bag b r) IO a }

instance Functor (Task b r) where
  fmap = liftM

instance Applicative (Task b r) where
  pure  = return
  (<*>) = ap

instance Monad (Task b r) where
  return = Task . return
  (Task a) >>= b = Task $ a >>= getTaskReader . b

instance MonadIO (Task b r) where
  liftIO act = Task $ lift act

runTask :: Task b r (Maybe r) -> Basic.Bag b r -> IO (Maybe r)
runTask = runReaderT . getTaskReader

-- | Add a task to the bag of tasks.
addTask :: (TaskBufferSTM b) => Task b r (Maybe r) -> Task b r ()
addTask task =
  Task $ do
    bag <- ask
    Basic.addTask bag (runTask task bag)