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 []