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