{-| Module : DeepControl.Monad.Reader Description : Copyright : (c) Andy Gill 2001, (c) Oregon Graduate Institute of Science and Technology 2001, (c) Jeff Newbern 2003-2007, (c) Andriy Palamarchuk 2007, (C) 2015 KONISHI Yohsuke, License : BSD-style (see the file LICENSE) Maintainer : ocean0yohsuke@gmail.com Stability : experimental Portability : --- This module is just a concise mimic for Reader Monad in mtl(monad-transformer-library). The qualifier "concise" means that this module doesn't make no attempt to transform functions of any kind of Monad automatically. So when making some new data type of ReaderT, you have to manually define involved Monad instances, for example `DeepControl.Monad.MonadError`, by making use of the transformation functions such as `trans`, `trans2`, etc. Admittedly it is tedious though, you can deeply understand monad-transformation mechanism instead. -} {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} module DeepControl.Monad.Reader ( MonadReader(..), asks, -- * Level-0 Reader(..), -- * Level-1 ReaderT(..), mapReaderT, liftCatch, -- * Level-2 ReaderT2(..), mapReaderT2, -- * Level-3 ReaderT3(..), mapReaderT3, ) where import DeepControl.Applicative import DeepControl.Monad import DeepControl.MonadTrans import Control.Monad.Reader (MonadReader(..)) import Control.Monad.Signatures asks :: MonadReader r m => (r -> a) -> m a asks = reader ---------------------------------------------------------------------- -- Level-0 newtype Reader r a = Reader { runReader :: r -> a } instance Functor (Reader r) where fmap f v = Reader $ \r -> f $ runReader v r instance Applicative (Reader r) where pure a = Reader $ \_ -> a (<*>) = ap instance Monad (Reader r) where return = pure mv >>= f = mv >- \(Reader v) -> Reader $ \r -> v r >- \a -> runReader (f a) r {- instance Monad2 (Reader r) where -- TODO: Reader を Commutative にできていないため、これは無理 mmv >>== f = mmv >>= \(Reader v) -> commute $ Reader $ \r -> v r >- \a -> runReader |$> f a |* r -} instance MonadReader r (Reader r) where ask = Reader id local f m = Reader $ runReader m . f ---------------------------------------------------------------------- -- Level-1 newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a } instance (Functor m) => Functor (ReaderT r m) where fmap f m = ReaderT $ \r -> f |$> runReaderT m r instance (Monad m) => Applicative (ReaderT s m) where pure a = ReaderT $ \_ -> (*:) a (<*>) = ap instance (Monad m) => Monad (ReaderT r m) where return = pure (ReaderT v) >>= f = ReaderT $ \r -> v r >>= \a -> runReaderT (f a) r instance (Monad m) => MonadReader r (ReaderT r m) where ask = ReaderT $ (*:) local f m = ReaderT $ runReaderT m . f instance MonadTrans (ReaderT r) where trans m = ReaderT $ \r -> m >>= \a -> (*:) a instance (MonadIO m, Monad m) => MonadIO (ReaderT r m) where liftIO = trans . liftIO mapReaderT :: (m a -> n b) -> ReaderT r m a -> ReaderT r n b mapReaderT f m = ReaderT $ f . runReaderT m liftCatch :: Catch e m a -> Catch e (ReaderT r m) a liftCatch catch m h = ReaderT $ \ r -> runReaderT m r `catch` \ e -> runReaderT (h e) r ---------------------------------------------------------------------- -- Level-2 newtype ReaderT2 r m1 m2 a = ReaderT2 { runReaderT2 :: r -> m1 (m2 a) } instance (Functor m1, Functor m2) => Functor (ReaderT2 r m1 m2) where fmap f m = ReaderT2 $ \r -> f |$>> runReaderT2 m r instance (Monad m1, Monad2 m2) => Applicative (ReaderT2 s m1 m2) where pure a = ReaderT2 $ \_ -> (**:) a (<*>) = ap instance (Monad m1, Monad2 m2) => Monad (ReaderT2 r m1 m2) where return = pure (ReaderT2 v) >>= f = ReaderT2 $ \r -> v r >>== \a -> runReaderT2 (f a) r instance (Monad m1, Monad2 m2) => MonadReader r (ReaderT2 r m1 m2) where ask = ReaderT2 $ (**:) local f m = ReaderT2 $ runReaderT2 m . f instance MonadTrans2 (ReaderT2 r) where trans2 m = ReaderT2 $ \r -> m >>== \a -> (**:) a instance (MonadIO m1, Monad m1, Monad2 m2) => MonadIO (ReaderT2 r m1 m2) where liftIO = trans2 . (-*) . liftIO mapReaderT2 :: (m1 (m2 a) -> n1 (n2 b)) -> ReaderT2 r m1 m2 a -> ReaderT2 r n1 n2 b mapReaderT2 f m = ReaderT2 $ f . runReaderT2 m ---------------------------------------------------------------------- -- Level-3 newtype ReaderT3 r m1 m2 m3 a = ReaderT3 { runReaderT3 :: r -> m1 (m2 (m3 a)) } instance (Functor m1, Functor m2, Functor m3) => Functor (ReaderT3 r m1 m2 m3) where fmap f m = ReaderT3 $ \r -> f |$>>> runReaderT3 m r instance (Monad m1, Monad2 m2, Monad3 m3) => Applicative (ReaderT3 s m1 m2 m3) where pure a = ReaderT3 $ \_ -> (***:) a (<*>) = ap instance (Monad m1, Monad2 m2, Monad3 m3) => Monad (ReaderT3 r m1 m2 m3) where return = pure (ReaderT3 v) >>= f = ReaderT3 $ \r -> v r >>>== \a -> runReaderT3 (f a) r instance (Monad m1, Monad2 m2, Monad3 m3) => MonadReader r (ReaderT3 r m1 m2 m3) where ask = ReaderT3 $ (***:) local f m = ReaderT3 $ runReaderT3 m . f instance MonadTrans3 (ReaderT3 r) where trans3 m = ReaderT3 $ \r -> m >>>== \a -> (***:) a instance (MonadIO m1, Monad m1, Monad2 m2, Monad3 m3) => MonadIO (ReaderT3 r m1 m2 m3) where liftIO = trans3 . (-**) . liftIO mapReaderT3 :: (m1 (m2 (m3 a)) -> n1 (n2 (n3 b))) -> ReaderT3 r m1 m2 m3 a -> ReaderT3 r n1 n2 n3 b mapReaderT3 f m = ReaderT3 $ f . runReaderT3 m