Control/Monad/Reader.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Control.Monad.Reader
   4 -- Copyright   :  (c) Andy Gill 2001,
   5 --                (c) Oregon Graduate Institute of Science and Technology, 2001
   6 -- License     :  BSD-style (see the file libraries/core/LICENSE)
   7 --
   8 -- Maintainer  :  libraries@haskell.org
   9 -- Stability   :  experimental
  10 -- Portability :  non-portable ( requires mulit-parameter type classes,
  11 --                               requires functional dependencies )
  12 --
  13 -- Declaration of the Monoid class,and instances for list and functions
  14 --
  15 --        Inspired by the paper
  16 --        \em{Functional Programming with Overloading and
  17 --            Higher-Order Polymorphism},
  18 --          \A[HREF="http://www.cse.ogi.edu/~mpj"]{Mark P Jones},
  19 --                Advanced School of Functional Programming, 1995.}
  20 -----------------------------------------------------------------------------
  21
  22 module Control.Monad.Reader (
  23         MonadReader(..),
  24         asks,
  25         Reader(..),
  26         runReader,
  27         mapReader,
  28         withReader,
  29         ReaderT(..),
  30         runReaderT,
  31         mapReaderT,
  32         withReaderT,
  33         module Control.Monad,
  34         module Control.Monad.Fix,
  35         module Control.Monad.Trans,
  36         ) where
  37
  38 import Prelude
  39
  40 import Control.Monad
  41 import Control.Monad.Fix
  42 import Control.Monad.Trans
  43
  44 -- ----------------------------------------------------------------------------
  45 -- class MonadReader
  46 --  asks for the internal (non-mutable) state.
  47
  48 class (Monad m) => MonadReader r m | m -> r where
  49         ask   :: m r
  50         local :: (r -> r) -> m a -> m a
  51
  52 -- This allows you to provide a projection function.
  53
  54 asks :: (MonadReader r m) => (r -> a) -> m a
  55 asks f = do
  56         r <- ask
  57         return (f r)
  58
  59 -- ----------------------------------------------------------------------------
  60 -- The partially applied function type is a simple reader monad
  61
  62 instance Functor ((->) r) where
  63         fmap = (.)
  64
  65 instance Monad ((->) r) where
  66         return  = const
  67         m >>= k = \r -> k (m r) r
  68
  69 instance MonadFix ((->) r) where
  70         mfix f = \r -> let a = f a r in a
  71
  72 instance MonadReader r ((->) r) where
  73         ask       = id
  74         local f m = m . f
  75
  76 -- ---------------------------------------------------------------------------
  77 -- Our parameterizable reader monad
  78
  79 newtype Reader r a = Reader { runReader :: r -> a }
  80
  81 instance Functor (Reader r) where
  82         fmap f m = Reader $ \r -> f (runReader m r)
  83
  84 instance Monad (Reader r) where
  85         return a = Reader $ \_ -> a
  86         m >>= k  = Reader $ \r -> runReader (k (runReader m r)) r
  87
  88 instance MonadFix (Reader r) where
  89         mfix f = Reader $ \r -> let a = runReader (f a) r in a
  90
  91 instance MonadReader r (Reader r) where
  92         ask       = Reader id
  93         local f m = Reader $ runReader m . f
  94
  95 mapReader :: (a -> b) -> Reader r a -> Reader r b
  96 mapReader f m = Reader $ f . runReader m
  97
  98 -- This is a more general version of local.
  99
 100 withReader :: (r' -> r) -> Reader r a -> Reader r' a
 101 withReader f m = Reader $ runReader m . f
 102
 103 -- ---------------------------------------------------------------------------
 104 -- Our parameterizable reader monad, with an inner monad
 105
 106 newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a }
 107
 108 instance (Monad m) => Functor (ReaderT r m) where
 109         fmap f m = ReaderT $ \r -> do
 110                 a <- runReaderT m r
 111                 return (f a)
 112
 113 instance (Monad m) => Monad (ReaderT r m) where
 114         return a = ReaderT $ \_ -> return a
 115         m >>= k  = ReaderT $ \r -> do
 116                 a <- runReaderT m r
 117                 runReaderT (k a) r
 118         fail msg = ReaderT $ \_ -> fail msg
 119
 120 instance (MonadPlus m) => MonadPlus (ReaderT r m) where
 121         mzero       = ReaderT $ \_ -> mzero
 122         m `mplus` n = ReaderT $ \r -> runReaderT m r `mplus` runReaderT n r
 123
 124 instance (MonadFix m) => MonadFix (ReaderT r m) where
 125         mfix f = ReaderT $ \r -> mfix $ \a -> runReaderT (f a) r
 126
 127 instance (Monad m) => MonadReader r (ReaderT r m) where
 128         ask       = ReaderT return
 129         local f m = ReaderT $ \r -> runReaderT m (f r)
 130
 131 instance MonadTrans (ReaderT r) where
 132         lift m = ReaderT $ \_ -> m
 133
 134 instance (MonadIO m) => MonadIO (ReaderT r m) where
 135         liftIO = lift . liftIO
 136
 137 mapReaderT :: (m a -> n b) -> ReaderT w m a -> ReaderT w n b
 138 mapReaderT f m = ReaderT $ f . runReaderT m
 139
 140 withReaderT :: (r' -> r) -> ReaderT r m a -> ReaderT r' m a
 141 withReaderT f m = ReaderT $ runReaderT m . f