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