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 ( mulit-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         runReader,
  26         mapReader,
  27         withReader,
  28         ReaderT(..),
  29         runReaderT,
  30         mapReaderT,
  31         withReaderT,
  32         module Control.Monad,
  33         module Control.Monad.Fix,
  34         module Control.Monad.Trans,
  35         ) where
  36
  37 import Prelude
  38
  39 import Control.Monad
  40 import Control.Monad.Fix
  41 import Control.Monad.Trans
  42
  43 -- ----------------------------------------------------------------------------
  44 -- class MonadReader
  45 --  asks for the internal (non-mutable) state.
  46
  47 class (Monad m) => MonadReader r m | m -> r where
  48         ask   :: m r
  49         local :: (r -> r) -> m a -> m a
  50
  51 -- This allows you to provide a projection function.
  52
  53 asks :: (MonadReader r m) => (r -> a) -> m a
  54 asks f = do
  55         r <- ask
  56         return (f r)
  57
  58 -- ----------------------------------------------------------------------------
  59 -- The partially applied function type is a simple reader monad
  60
  61 instance Functor ((->) r) where
  62         fmap = (.)
  63
  64 instance Monad ((->) r) where
  65         return  = const
  66         m >>= k = \r -> k (m r) r
  67
  68 instance MonadFix ((->) r) where
  69         mfix f = \r -> let a = f a r in a
  70
  71 instance MonadReader r ((->) r) where
  72         ask       = id
  73         local f m = m . f
  74
  75 -- ---------------------------------------------------------------------------
  76 -- Our parameterizable reader monad
  77
  78 newtype Reader r a = Reader { runReader :: r -> a }
  79
  80 instance Functor (Reader r) where
  81         fmap f m = Reader $ \r -> f (runReader m r)
  82
  83 instance Monad (Reader r) where
  84         return a = Reader $ \_ -> a
  85         m >>= k  = Reader $ \r -> runReader (k (runReader m r)) r
  86
  87 instance MonadFix (Reader r) where
  88         mfix f = Reader $ \r -> let a = runReader (f a) r in a
  89
  90 instance MonadReader r (Reader r) where
  91         ask       = Reader id
  92         local f m = Reader $ runReader m . f
  93
  94 mapReader :: (a -> b) -> Reader r a -> Reader r b
  95 mapReader f m = Reader $ f . runReader m
  96
  97 -- This is a more general version of local.
  98
  99 withReader :: (r' -> r) -> Reader r a -> Reader r' a
 100 withReader f m = Reader $ runReader m . f
 101
 102 -- ---------------------------------------------------------------------------
 103 -- Our parameterizable reader monad, with an inner monad
 104
 105 newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a }
 106
 107 instance (Monad m) => Functor (ReaderT r m) where
 108         fmap f m = ReaderT $ \r -> do
 109                 a <- runReaderT m r
 110                 return (f a)
 111
 112 instance (Monad m) => Monad (ReaderT r m) where
 113         return a = ReaderT $ \_ -> return a
 114         m >>= k  = ReaderT $ \r -> do
 115                 a <- runReaderT m r
 116                 runReaderT (k a) r
 117         fail msg = ReaderT $ \_ -> fail msg
 118
 119 instance (MonadPlus m) => MonadPlus (ReaderT r m) where
 120         mzero       = ReaderT $ \_ -> mzero
 121         m `mplus` n = ReaderT $ \r -> runReaderT m r `mplus` runReaderT n r
 122
 123 instance (MonadFix m) => MonadFix (ReaderT r m) where
 124         mfix f = ReaderT $ \r -> mfix $ \a -> runReaderT (f a) r
 125
 126 instance (Monad m) => MonadReader r (ReaderT r m) where
 127         ask       = ReaderT return
 128         local f m = ReaderT $ \r -> runReaderT m (f r)
 129
 130 instance MonadTrans (ReaderT r) where
 131         lift m = ReaderT $ \_ -> m
 132
 133 instance (MonadIO m) => MonadIO (ReaderT r m) where
 134         liftIO = lift . liftIO
 135
 136 mapReaderT :: (m a -> n b) -> ReaderT w m a -> ReaderT w n b
 137 mapReaderT f m = ReaderT $ f . runReaderT m
 138
 139 withReaderT :: (r' -> r) -> ReaderT r m a -> ReaderT r' m a
 140 withReaderT f m = ReaderT $ runReaderT m . f