module Control.Monad.Trans.MultiReader.Lazy
(
MultiReaderT(..)
, MultiReaderTNull
, MultiReader
, MonadMultiReader(..)
, runMultiReaderT
, runMultiReaderT_
, runMultiReaderTNil
, runMultiReaderTNil_
, withMultiReader
, withMultiReader_
, withMultiReaders
, withMultiReaders_
, inflateReader
, mapMultiReaderT
, mGetRaw
, mPutRaw
) where
import Data.HList.HList
import Data.HList.ContainsType
import Control.Monad.Trans.MultiReader.Class ( MonadMultiReader(..) )
import Control.Monad.State.Lazy ( StateT(..)
, MonadState(..)
, evalStateT
, mapStateT )
import Control.Monad.Reader ( ReaderT(..) )
import Control.Monad.Trans.Class ( MonadTrans
, lift )
import Control.Monad.Writer.Class ( MonadWriter
, listen
, tell
, writer
, pass )
import Data.Functor.Identity ( Identity )
import Control.Applicative ( Applicative(..) )
import Control.Monad ( liftM
, ap
, void )
newtype MultiReaderT x m a = MultiReaderT {
runMultiReaderTRaw :: StateT (HList x) m a
}
type MultiReaderTNull = MultiReaderT '[]
type MultiReader x = MultiReaderT x Identity
instance (Functor f) => Functor (MultiReaderT x f) where
fmap f = MultiReaderT . fmap f . runMultiReaderTRaw
instance (Applicative m, Monad m) => Applicative (MultiReaderT x m) where
pure = MultiReaderT . pure
(<*>) = ap
instance Monad m => Monad (MultiReaderT x m) where
return = MultiReaderT . return
k >>= f = MultiReaderT $ runMultiReaderTRaw k >>= runMultiReaderTRaw . f
instance MonadTrans (MultiReaderT x) where
lift = MultiReaderT . lift
instance (Monad m, ContainsType a c)
=> MonadMultiReader a (MultiReaderT c m) where
mAsk = MultiReaderT $ liftM getHListElem get
mGetRaw :: Monad m => MultiReaderT a m (HList a)
mGetRaw = MultiReaderT get
mPutRaw :: Monad m => HList s -> MultiReaderT s m ()
mPutRaw = MultiReaderT . put
mapMultiReaderT :: (m (a, HList w) -> m' (a', HList w))
-> MultiReaderT w m a
-> MultiReaderT w m' a'
mapMultiReaderT f = MultiReaderT . mapStateT f . runMultiReaderTRaw
runMultiReaderT :: Monad m => HList r -> MultiReaderT r m a -> m a
runMultiReaderT_ :: Functor m => HList r -> MultiReaderT r m a -> m ()
runMultiReaderT s k = evalStateT (runMultiReaderTRaw k) s
runMultiReaderT_ s k = void $ runStateT (runMultiReaderTRaw k) s
runMultiReaderTNil :: Monad m => MultiReaderT '[] m a -> m a
runMultiReaderTNil_ :: Functor m => MultiReaderT '[] m a -> m ()
runMultiReaderTNil k = evalStateT (runMultiReaderTRaw k) HNil
runMultiReaderTNil_ k = void $ runStateT (runMultiReaderTRaw k) HNil
withMultiReader :: Monad m => r -> MultiReaderT (r ': rs) m a -> MultiReaderT rs m a
withMultiReader_ :: (Functor m, Monad m) => r -> MultiReaderT (r ': rs) m a -> MultiReaderT rs m ()
withMultiReader x k = MultiReaderT $
get >>= lift . evalStateT (runMultiReaderTRaw k) . (x :+:)
withMultiReader_ x k = void $ withMultiReader x k
withMultiReaders :: Monad m => HList r1 -> MultiReaderT (Append r1 r2) m a -> MultiReaderT r2 m a
withMultiReaders_ :: (Functor m, Monad m) => HList r1 -> MultiReaderT (Append r1 r2) m a -> MultiReaderT r2 m ()
withMultiReaders HNil = id
withMultiReaders (x :+: xs) = withMultiReaders xs . withMultiReader x
withMultiReaders_ HNil = liftM (const ())
withMultiReaders_ (x :+: xs) = withMultiReaders_ xs . withMultiReader_ x
inflateReader :: (Monad m, ContainsType r rs)
=> ReaderT r m a
-> MultiReaderT rs m a
inflateReader k = mAsk >>= lift . runReaderT k
instance (MonadState s m) => MonadState s (MultiReaderT c m) where
put = lift . put
get = lift $ get
state = lift . state
instance (MonadWriter w m) => MonadWriter w (MultiReaderT c m) where
writer = lift . writer
tell = lift . tell
listen = MultiReaderT .
mapStateT (liftM (\(~(~(a,w), w')) -> ((a, w'), w)) . listen) .
runMultiReaderTRaw
pass = MultiReaderT .
mapStateT (pass . liftM (\(~(~(a, f), w)) -> ((a, w), f))) .
runMultiReaderTRaw