{-|
Module      : Control.Concurrent.Bag.Task
Description : Monad transformer implementation for reading values
Copyright   : (c) Bastian Holst, 2014
License     : BSD3
Maintainer  : bastianholst@gmx.de
Stability   : experimental
Portability : POSIX

A monad transformer implementation for processing the results of a bag of
tasks computation. Using a processor based on the 'BagT' transformer allows
the calculation of values to be aborted immediately after running the
processor.

This can be use by some of the bag of tasks interfaces such as
"Control.Concurrent.Bag.Safe"
and "Control.Concurrent.Bag.SafeConcurrent".
-}
module Control.Concurrent.Bag.BagT
  ( BagT (..)
  , getResult
  , getAllResults )
where

import Control.Applicative
import Control.Monad.Reader

-- | A monad transformer for processing the results of the bag sequencially.
--   In addition to the actions available in the base monad, which has to be
--   an instance of MonadIO in all functions, it provides the action
--   'getResult' to get a result of the bag.
newtype BagT r m a = BagT { getBagReader :: ReaderT (m (Maybe r)) m a }

instance Monad m => Functor (BagT r m) where
  fmap = liftM

instance Monad m => Applicative (BagT r m) where
  pure  = return
  (<*>) = ap

instance Monad m => Monad (BagT r m) where
  return = BagT . return
  (BagT a) >>= b = BagT $ a >>= getBagReader . b

instance MonadTrans (BagT r) where
  lift act = BagT $ lift act

instance MonadIO m => MonadIO (BagT r m) where
  liftIO act = BagT $ liftIO act

-- | Get a result of the bag if there is one. If it returns Nothing, all tasks
--   have been processed and there are no results left. 'getResults' blocks
--   until a task has been evaluated to a result or all tasks are processed.
--   Therefore it may block forever.
getResult :: (MonadIO m) => BagT r m (Maybe r)
getResult = do
  gr <- BagT $ ask
  lift gr

-- | Convenience function to get all results from the bag of tasks.
getAllResults :: (MonadIO m) => BagT a m [a]
getAllResults = do
  mx  <- getResult
  case mx of
    Just x -> do
      xs <- getAllResults
      return $ x:xs
    Nothing ->
      return   []