Copyright | (c) Andy Gill 2001 (c) Oregon Graduate Institute of Science and Technology 2001 (c) Jeff Newbern 2003-2007 (c) Andriy Palamarchuk 2007 |
---|---|
License | BSD-style (see the file LICENSE) |
Maintainer | libraries@haskell.org |
Stability | experimental |
Portability | non-portable (multi-param classes, functional dependencies) |
Safe Haskell | Safe |
Language | Haskell2010 |
- Computation type:
- Computations which read values from a shared environment.
- Binding strategy:
- Monad values are functions from the environment to a value. The bound function is applied to the bound value, and both have access to the shared environment.
- Useful for:
- Maintaining variable bindings, or other shared environment.
- Zero and plus:
- None.
- Example type:
Reader
[(String,Value)] a
The Reader
monad (also called the Environment monad).
Represents a computation, which can read values from
a shared environment, pass values from function to function,
and execute sub-computations in a modified environment.
Using Reader
monad for such computations is often clearer and easier
than using the State
monad.
Inspired by the paper Functional Programming with Overloading and Higher-Order Polymorphism, Mark P Jones (http://web.cecs.pdx.edu/~mpj/) Advanced School of Functional Programming, 1995.
Synopsis
- class Monad m => MonadReader r m | m -> r where
- asks :: MonadReader r m => (r -> a) -> m a
- type Reader r = ReaderT r Identity
- runReader :: Reader r a -> r -> a
- mapReader :: (a -> b) -> Reader r a -> Reader r b
- withReader :: (r' -> r) -> Reader r a -> Reader r' a
- newtype ReaderT r (m :: Type -> Type) a = ReaderT (r -> m a)
- runReaderT :: ReaderT r m a -> r -> m a
- mapReaderT :: (m a -> n b) -> ReaderT r m a -> ReaderT r n b
- withReaderT :: forall r' r (m :: Type -> Type) a. (r' -> r) -> ReaderT r m a -> ReaderT r' m a
- module Control.Monad.Trans
MonadReader class
class Monad m => MonadReader r m | m -> r where Source #
See examples in Control.Monad.Reader.
Note, the partially applied function type (->) r
is a simple reader monad.
See the instance
declaration below.
Retrieves the monad environment.
:: (r -> r) | The function to modify the environment. |
-> m a |
|
-> m a |
Executes a computation in a modified environment.
:: (r -> a) | The selector function to apply to the environment. |
-> m a |
Retrieves a function of the current environment.
Instances
MonadReader r m => MonadReader r (MaybeT m) Source # | |
(Monoid w, MonadReader r m) => MonadReader r (AccumT w m) Source # | Since: mtl-2.3 |
MonadReader r m => MonadReader r (ExceptT e m) Source # | Since: mtl-2.2 |
MonadReader r m => MonadReader r (IdentityT m) Source # | |
Monad m => MonadReader r (ReaderT r m) Source # | |
MonadReader r m => MonadReader r (StateT s m) Source # | |
MonadReader r m => MonadReader r (StateT s m) Source # | |
(Monoid w, MonadReader r m) => MonadReader r (WriterT w m) Source # | Since: mtl-2.3 |
(Monoid w, MonadReader r m) => MonadReader r (WriterT w m) Source # | |
(Monoid w, MonadReader r m) => MonadReader r (WriterT w m) Source # | |
MonadReader r' m => MonadReader r' (SelectT r m) Source # | Since: mtl-2.3 |
MonadReader r ((->) r) Source # | |
MonadReader r' m => MonadReader r' (ContT r m) Source # | |
(Monad m, Monoid w) => MonadReader r (RWST r w s m) Source # | Since: mtl-2.3 |
(Monad m, Monoid w) => MonadReader r (RWST r w s m) Source # | |
(Monad m, Monoid w) => MonadReader r (RWST r w s m) Source # | |
:: MonadReader r m | |
=> (r -> a) | The selector function to apply to the environment. |
-> m a |
Retrieves a function of the current environment.
The Reader monad
type Reader r = ReaderT r Identity Source #
The parameterizable reader monad.
Computations are functions of a shared environment.
The return
function ignores the environment, while >>=
passes
the inherited environment to both subcomputations.
:: Reader r a | A |
-> r | An initial environment. |
-> a |
Runs a Reader
and extracts the final value from it.
(The inverse of reader
.)
:: (r' -> r) | The function to modify the environment. |
-> Reader r a | Computation to run in the modified environment. |
-> Reader r' a |
Execute a computation in a modified environment
(a specialization of withReaderT
).
runReader
(withReader
f m) =runReader
m . f
The ReaderT monad transformer
newtype ReaderT r (m :: Type -> Type) a Source #
The reader monad transformer, which adds a read-only environment to the given monad.
The return
function ignores the environment, while >>=
passes
the inherited environment to both subcomputations.
ReaderT (r -> m a) |
Instances
Generic1 (ReaderT r m :: Type -> Type) | |
MonadAccum w m => MonadAccum w (ReaderT r m) Source # | Since: mtl-2.3 |
MonadError e m => MonadError e (ReaderT r m) Source # | |
Defined in Control.Monad.Error.Class throwError :: e -> ReaderT r m a Source # catchError :: ReaderT r m a -> (e -> ReaderT r m a) -> ReaderT r m a Source # | |
Monad m => MonadReader r (ReaderT r m) Source # | |
MonadSelect r' m => MonadSelect r' (ReaderT r m) Source # | Provides a read-only environment of type Since: mtl-2.3 |
Defined in Control.Monad.Select | |
MonadState s m => MonadState s (ReaderT r m) Source # | |
MonadWriter w m => MonadWriter w (ReaderT r m) Source # | |
MonadTrans (ReaderT r) | |
MonadFail m => MonadFail (ReaderT r m) | |
MonadFix m => MonadFix (ReaderT r m) | |
MonadIO m => MonadIO (ReaderT r m) | |
MonadZip m => MonadZip (ReaderT r m) | |
Contravariant m => Contravariant (ReaderT r m) | |
Alternative m => Alternative (ReaderT r m) | |
Applicative m => Applicative (ReaderT r m) | |
Defined in Control.Monad.Trans.Reader pure :: a -> ReaderT r m a Source # (<*>) :: ReaderT r m (a -> b) -> ReaderT r m a -> ReaderT r m b Source # liftA2 :: (a -> b -> c) -> ReaderT r m a -> ReaderT r m b -> ReaderT r m c Source # (*>) :: ReaderT r m a -> ReaderT r m b -> ReaderT r m b Source # (<*) :: ReaderT r m a -> ReaderT r m b -> ReaderT r m a Source # | |
Functor m => Functor (ReaderT r m) | |
Monad m => Monad (ReaderT r m) | |
MonadPlus m => MonadPlus (ReaderT r m) | |
MonadCont m => MonadCont (ReaderT r m) Source # | |
Generic (ReaderT r m a) | |
type Rep1 (ReaderT r m :: Type -> Type) | |
Defined in Control.Monad.Trans.Reader type Rep1 (ReaderT r m :: Type -> Type) = D1 ('MetaData "ReaderT" "Control.Monad.Trans.Reader" "transformers-0.6.1.0" 'True) (C1 ('MetaCons "ReaderT" 'PrefixI 'True) (S1 ('MetaSel ('Just "runReaderT") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) ((FUN 'Many r :: Type -> Type) :.: Rec1 m))) | |
type Rep (ReaderT r m a) | |
Defined in Control.Monad.Trans.Reader |
runReaderT :: ReaderT r m a -> r -> m a Source #
mapReaderT :: (m a -> n b) -> ReaderT r m a -> ReaderT r n b Source #
Transform the computation inside a ReaderT
.
runReaderT
(mapReaderT
f m) = f .runReaderT
m
:: forall r' r (m :: Type -> Type) a. (r' -> r) | The function to modify the environment. |
-> ReaderT r m a | Computation to run in the modified environment. |
-> ReaderT r' m a |
Execute a computation in a modified environment
(a more general version of local
).
runReaderT
(withReaderT
f m) =runReaderT
m . f
module Control.Monad.Trans
Example 1: Simple Reader Usage
In this example the Reader
monad provides access to variable bindings.
Bindings are a Map
of integer variables.
The variable count
contains number of variables in the bindings.
You can see how to run a Reader monad and retrieve data from it
with runReader
, how to access the Reader data with ask
and asks
.
import Control.Monad.Reader import Data.Map (Map) import qualified Data.Map as Map type Bindings = Map String Int -- Returns True if the "count" variable contains correct bindings size. isCountCorrect :: Bindings -> Bool isCountCorrect bindings = runReader calc_isCountCorrect bindings -- The Reader monad, which implements this complicated check. calc_isCountCorrect :: Reader Bindings Bool calc_isCountCorrect = do count <- asks (lookupVar "count") bindings <- ask return (count == (Map.size bindings)) -- The selector function to use with 'asks'. -- Returns value of the variable with specified name. lookupVar :: String -> Bindings -> Int lookupVar name bindings = maybe 0 id (Map.lookup name bindings) sampleBindings :: Bindings sampleBindings = Map.fromList [("count", 3), ("1", 1), ("b", 2)] main :: IO () main = do putStr $ "Count is correct for bindings " ++ (show sampleBindings) ++ ": " putStrLn $ show (isCountCorrect sampleBindings)
Example 2: Modifying Reader Content With local
Shows how to modify Reader content with local
.
import Control.Monad.Reader calculateContentLen :: Reader String Int calculateContentLen = do content <- ask return (length content); -- Calls calculateContentLen after adding a prefix to the Reader content. calculateModifiedContentLen :: Reader String Int calculateModifiedContentLen = local ("Prefix " ++) calculateContentLen main :: IO () main = do let s = "12345"; let modifiedLen = runReader calculateModifiedContentLen s let len = runReader calculateContentLen s putStrLn $ "Modified 's' length: " ++ (show modifiedLen) putStrLn $ "Original 's' length: " ++ (show len)
Example 3: ReaderT
Monad Transformer
Now you are thinking: 'Wow, what a great monad! I wish I could use
Reader functionality in MyFavoriteComplexMonad!'. Don't worry.
This can be easily done with the ReaderT
monad transformer.
This example shows how to combine ReaderT
with the IO monad.
import Control.Monad.Reader -- The Reader/IO combined monad, where Reader stores a string. printReaderContent :: ReaderT String IO () printReaderContent = do content <- ask liftIO $ putStrLn ("The Reader Content: " ++ content) main :: IO () main = runReaderT printReaderContent "Some Content"