2020-08-18 23:58:10 +03:00
|
|
|
module Control.Monad.Reader
|
|
|
|
|
|
|
|
import Control.Monad.Identity
|
|
|
|
import Control.Monad.Trans
|
|
|
|
|
|
|
|
||| A computation which runs in a static context and produces an output
|
|
|
|
public export
|
2020-12-11 14:58:26 +03:00
|
|
|
interface Monad m => MonadReader stateType m | m where
|
2020-08-18 23:58:10 +03:00
|
|
|
||| Get the context
|
|
|
|
ask : m stateType
|
|
|
|
|
2020-08-20 17:32:24 +03:00
|
|
|
||| `local f c` runs the computation `c` in an environment modified by `f`.
|
|
|
|
local : MonadReader stateType m => (stateType -> stateType) -> m a -> m a
|
|
|
|
|
2020-08-18 23:58:10 +03:00
|
|
|
||| The transformer on which the Reader monad is based
|
|
|
|
public export
|
2020-09-15 20:29:17 +03:00
|
|
|
record ReaderT (stateType : Type) (m : Type -> Type) (a : Type) where
|
2020-08-18 23:58:10 +03:00
|
|
|
constructor MkReaderT
|
2021-01-11 14:24:43 +03:00
|
|
|
1 runReaderT' : stateType -> m a
|
2020-08-18 23:58:10 +03:00
|
|
|
|
|
|
|
public export
|
|
|
|
implementation Functor f => Functor (ReaderT stateType f) where
|
|
|
|
map f (MkReaderT g) = MkReaderT (\st => map f (g st))
|
|
|
|
|
|
|
|
public export
|
|
|
|
implementation Applicative f => Applicative (ReaderT stateType f) where
|
|
|
|
pure x = MkReaderT (\st => pure x)
|
|
|
|
|
|
|
|
(MkReaderT f) <*> (MkReaderT a) =
|
|
|
|
MkReaderT (\st =>
|
|
|
|
let f' = f st in
|
|
|
|
let a' = a st in
|
|
|
|
f' <*> a')
|
|
|
|
|
|
|
|
public export
|
|
|
|
implementation Monad m => Monad (ReaderT stateType m) where
|
|
|
|
(MkReaderT f) >>= k =
|
|
|
|
MkReaderT (\st => do v <- f st
|
|
|
|
let MkReaderT kv = k v
|
|
|
|
kv st)
|
|
|
|
|
|
|
|
public export
|
|
|
|
implementation MonadTrans (ReaderT stateType) where
|
|
|
|
lift x = MkReaderT (\_ => x)
|
|
|
|
|
|
|
|
public export
|
|
|
|
implementation Monad m => MonadReader stateType (ReaderT stateType m) where
|
|
|
|
ask = MkReaderT (\st => pure st)
|
|
|
|
|
2020-08-20 17:32:24 +03:00
|
|
|
local f (MkReaderT action) = MkReaderT (action . f)
|
|
|
|
|
2020-08-18 23:58:10 +03:00
|
|
|
public export
|
|
|
|
implementation HasIO m => HasIO (ReaderT stateType m) where
|
|
|
|
liftIO f = MkReaderT (\_ => liftIO f)
|
|
|
|
|
|
|
|
public export
|
|
|
|
implementation (Monad f, Alternative f) => Alternative (ReaderT stateType f) where
|
|
|
|
empty = lift empty
|
|
|
|
|
|
|
|
(MkReaderT f) <|> (MkReaderT g) = MkReaderT (\st => f st <|> g st)
|
|
|
|
|
|
|
|
||| Evaluate a function in the context held by this computation
|
|
|
|
public export
|
|
|
|
asks : MonadReader stateType m => (stateType -> a) -> m a
|
|
|
|
asks f = ask >>= pure . f
|
|
|
|
|
2020-09-15 20:29:17 +03:00
|
|
|
||| Unwrap and apply a ReaderT monad computation
|
|
|
|
public export
|
|
|
|
%inline
|
|
|
|
runReaderT : stateType -> ReaderT stateType m a -> m a
|
|
|
|
runReaderT s action = runReaderT' action s
|
|
|
|
|
2020-08-18 23:58:10 +03:00
|
|
|
||| The Reader monad. The ReaderT transformer applied to the Identity monad.
|
|
|
|
public export
|
|
|
|
Reader : (stateType : Type) -> (a : Type) -> Type
|
|
|
|
Reader s a = ReaderT s Identity a
|
|
|
|
|
2020-09-15 20:29:17 +03:00
|
|
|
||| Unwrap and apply a Reader monad computation
|
2020-08-18 23:58:10 +03:00
|
|
|
public export
|
2020-09-15 20:29:17 +03:00
|
|
|
runReader : stateType -> Reader stateType a -> a
|
|
|
|
runReader s = runIdentity . runReaderT s
|