{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Safe #-}
#endif
#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE AutoDeriveTypeable #-}
#endif
module Control.Monad.Trans.Reader (
Reader,
reader,
runReader,
mapReader,
withReader,
ReaderT(..),
mapReaderT,
withReaderT,
ask,
local,
asks,
liftCallCC,
liftCatch,
) where
import Control.Monad.IO.Class
import Control.Monad.Signatures
import Control.Monad.Trans.Class
#if MIN_VERSION_base(4,12,0)
import Data.Functor.Contravariant
#endif
import Data.Functor.Identity
import Control.Applicative
import Control.Monad
#if MIN_VERSION_base(4,9,0)
import qualified Control.Monad.Fail as Fail
#endif
import Control.Monad.Fix
#if !(MIN_VERSION_base(4,6,0))
import Control.Monad.Instances ()
#endif
#if MIN_VERSION_base(4,4,0)
import Control.Monad.Zip (MonadZip(mzipWith))
#endif
#if MIN_VERSION_base(4,2,0)
import Data.Functor(Functor(..))
#endif
type Reader r = ReaderT r Identity
reader :: (Monad m) => (r -> a) -> ReaderT r m a
reader :: (r -> a) -> ReaderT r m a
reader r -> a
f = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> (r -> a) -> r -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> a
f)
{-# INLINE reader #-}
runReader
:: Reader r a
-> r
-> a
runReader :: Reader r a -> r -> a
runReader Reader r a
m = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> (r -> Identity a) -> r -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader r a -> r -> Identity a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Reader r a
m
{-# INLINE runReader #-}
mapReader :: (a -> b) -> Reader r a -> Reader r b
mapReader :: (a -> b) -> Reader r a -> Reader r b
mapReader a -> b
f = (Identity a -> Identity b) -> Reader r a -> Reader r b
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (Identity a -> b) -> Identity a -> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f (a -> b) -> (Identity a -> a) -> Identity a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity)
{-# INLINE mapReader #-}
withReader
:: (r' -> r)
-> Reader r a
-> Reader r' a
withReader :: (r' -> r) -> Reader r a -> Reader r' a
withReader = (r' -> r) -> Reader r a -> Reader r' a
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
{-# INLINE withReader #-}
newtype ReaderT r m a = ReaderT { ReaderT r m a -> r -> m a
runReaderT :: r -> m a }
mapReaderT :: (m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT :: (m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m a -> n b
f ReaderT r m a
m = (r -> n b) -> ReaderT r n b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> n b) -> ReaderT r n b) -> (r -> n b) -> ReaderT r n b
forall a b. (a -> b) -> a -> b
$ m a -> n b
f (m a -> n b) -> (r -> m a) -> r -> n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m
{-# INLINE mapReaderT #-}
withReaderT
:: (r' -> r)
-> ReaderT r m a
-> ReaderT r' m a
withReaderT :: (r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT r' -> r
f ReaderT r m a
m = (r' -> m a) -> ReaderT r' m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r' -> m a) -> ReaderT r' m a) -> (r' -> m a) -> ReaderT r' m a
forall a b. (a -> b) -> a -> b
$ ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m (r -> m a) -> (r' -> r) -> r' -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r' -> r
f
{-# INLINE withReaderT #-}
instance (Functor m) => Functor (ReaderT r m) where
fmap :: (a -> b) -> ReaderT r m a -> ReaderT r m b
fmap a -> b
f = (m a -> m b) -> ReaderT r m a -> ReaderT r m b
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)
{-# INLINE fmap #-}
#if MIN_VERSION_base(4,2,0)
a
x <$ :: a -> ReaderT r m b -> ReaderT r m a
<$ ReaderT r m b
v = (m b -> m a) -> ReaderT r m b -> ReaderT r m a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (a
x a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) ReaderT r m b
v
{-# INLINE (<$) #-}
#endif
instance (Applicative m) => Applicative (ReaderT r m) where
pure :: a -> ReaderT r m a
pure = m a -> ReaderT r m a
forall (m :: * -> *) a r. m a -> ReaderT r m a
liftReaderT (m a -> ReaderT r m a) -> (a -> m a) -> a -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE pure #-}
ReaderT r m (a -> b)
f <*> :: ReaderT r m (a -> b) -> ReaderT r m a -> ReaderT r m b
<*> ReaderT r m a
v = (r -> m b) -> ReaderT r m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m b) -> ReaderT r m b) -> (r -> m b) -> ReaderT r m b
forall a b. (a -> b) -> a -> b
$ \ r
r -> ReaderT r m (a -> b) -> r -> m (a -> b)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m (a -> b)
f r
r m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
v r
r
{-# INLINE (<*>) #-}
#if MIN_VERSION_base(4,2,0)
ReaderT r m a
u *> :: ReaderT r m a -> ReaderT r m b -> ReaderT r m b
*> ReaderT r m b
v = (r -> m b) -> ReaderT r m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m b) -> ReaderT r m b) -> (r -> m b) -> ReaderT r m b
forall a b. (a -> b) -> a -> b
$ \ r
r -> ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
u r
r m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReaderT r m b -> r -> m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m b
v r
r
{-# INLINE (*>) #-}
ReaderT r m a
u <* :: ReaderT r m a -> ReaderT r m b -> ReaderT r m a
<* ReaderT r m b
v = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a) -> (r -> m a) -> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ \ r
r -> ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
u r
r m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReaderT r m b -> r -> m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m b
v r
r
{-# INLINE (<*) #-}
#endif
#if MIN_VERSION_base(4,10,0)
liftA2 :: (a -> b -> c) -> ReaderT r m a -> ReaderT r m b -> ReaderT r m c
liftA2 a -> b -> c
f ReaderT r m a
x ReaderT r m b
y = (r -> m c) -> ReaderT r m c
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m c) -> ReaderT r m c) -> (r -> m c) -> ReaderT r m c
forall a b. (a -> b) -> a -> b
$ \ r
r -> (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f (ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
x r
r) (ReaderT r m b -> r -> m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m b
y r
r)
{-# INLINE liftA2 #-}
#endif
instance (Alternative m) => Alternative (ReaderT r m) where
empty :: ReaderT r m a
empty = m a -> ReaderT r m a
forall (m :: * -> *) a r. m a -> ReaderT r m a
liftReaderT m a
forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE empty #-}
ReaderT r m a
m <|> :: ReaderT r m a -> ReaderT r m a -> ReaderT r m a
<|> ReaderT r m a
n = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a) -> (r -> m a) -> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ \ r
r -> ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m r
r m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
n r
r
{-# INLINE (<|>) #-}
instance (Monad m) => Monad (ReaderT r m) where
#if !(MIN_VERSION_base(4,8,0))
return = lift . return
{-# INLINE return #-}
#endif
ReaderT r m a
m >>= :: ReaderT r m a -> (a -> ReaderT r m b) -> ReaderT r m b
>>= a -> ReaderT r m b
k = (r -> m b) -> ReaderT r m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m b) -> ReaderT r m b) -> (r -> m b) -> ReaderT r m b
forall a b. (a -> b) -> a -> b
$ \ r
r -> do
a
a <- ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m r
r
ReaderT r m b -> r -> m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (a -> ReaderT r m b
k a
a) r
r
{-# INLINE (>>=) #-}
#if MIN_VERSION_base(4,8,0)
>> :: ReaderT r m a -> ReaderT r m b -> ReaderT r m b
(>>) = ReaderT r m a -> ReaderT r m b -> ReaderT r m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
#else
m >> k = ReaderT $ \ r -> runReaderT m r >> runReaderT k r
#endif
{-# INLINE (>>) #-}
#if !(MIN_VERSION_base(4,13,0))
fail msg = lift (fail msg)
{-# INLINE fail #-}
#endif
#if MIN_VERSION_base(4,9,0)
instance (Fail.MonadFail m) => Fail.MonadFail (ReaderT r m) where
fail :: String -> ReaderT r m a
fail String
msg = m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
msg)
{-# INLINE fail #-}
#endif
instance (MonadPlus m) => MonadPlus (ReaderT r m) where
mzero :: ReaderT r m a
mzero = m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
{-# INLINE mzero #-}
ReaderT r m a
m mplus :: ReaderT r m a -> ReaderT r m a -> ReaderT r m a
`mplus` ReaderT r m a
n = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a) -> (r -> m a) -> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ \ r
r -> ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m r
r m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
n r
r
{-# INLINE mplus #-}
instance (MonadFix m) => MonadFix (ReaderT r m) where
mfix :: (a -> ReaderT r m a) -> ReaderT r m a
mfix a -> ReaderT r m a
f = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a) -> (r -> m a) -> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ \ r
r -> (a -> m a) -> m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((a -> m a) -> m a) -> (a -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \ a
a -> ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (a -> ReaderT r m a
f a
a) r
r
{-# INLINE mfix #-}
instance MonadTrans (ReaderT r) where
lift :: m a -> ReaderT r m a
lift = m a -> ReaderT r m a
forall (m :: * -> *) a r. m a -> ReaderT r m a
liftReaderT
{-# INLINE lift #-}
instance (MonadIO m) => MonadIO (ReaderT r m) where
liftIO :: IO a -> ReaderT r m a
liftIO = m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT r m a) -> (IO a -> m a) -> IO a -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
{-# INLINE liftIO #-}
#if MIN_VERSION_base(4,4,0)
instance (MonadZip m) => MonadZip (ReaderT r m) where
mzipWith :: (a -> b -> c) -> ReaderT r m a -> ReaderT r m b -> ReaderT r m c
mzipWith a -> b -> c
f (ReaderT r -> m a
m) (ReaderT r -> m b
n) = (r -> m c) -> ReaderT r m c
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m c) -> ReaderT r m c) -> (r -> m c) -> ReaderT r m c
forall a b. (a -> b) -> a -> b
$ \ r
a ->
(a -> b -> c) -> m a -> m b -> m c
forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith a -> b -> c
f (r -> m a
m r
a) (r -> m b
n r
a)
{-# INLINE mzipWith #-}
#endif
#if MIN_VERSION_base(4,12,0)
instance Contravariant m => Contravariant (ReaderT r m) where
contramap :: (a -> b) -> ReaderT r m b -> ReaderT r m a
contramap a -> b
f = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a)
-> (ReaderT r m b -> r -> m a) -> ReaderT r m b -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m b -> m a) -> (r -> m b) -> r -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> m b -> m a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f) ((r -> m b) -> r -> m a)
-> (ReaderT r m b -> r -> m b) -> ReaderT r m b -> r -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT r m b -> r -> m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
{-# INLINE contramap #-}
#endif
liftReaderT :: m a -> ReaderT r m a
liftReaderT :: m a -> ReaderT r m a
liftReaderT m a
m = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (m a -> r -> m a
forall a b. a -> b -> a
const m a
m)
{-# INLINE liftReaderT #-}
ask :: (Monad m) => ReaderT r m r
ask :: ReaderT r m r
ask = (r -> m r) -> ReaderT r m r
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT r -> m r
forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINE ask #-}
local
:: (r -> r)
-> ReaderT r m a
-> ReaderT r m a
local :: (r -> r) -> ReaderT r m a -> ReaderT r m a
local = (r -> r) -> ReaderT r m a -> ReaderT r m a
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
{-# INLINE local #-}
asks :: (Monad m)
=> (r -> a)
-> ReaderT r m a
asks :: (r -> a) -> ReaderT r m a
asks r -> a
f = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> (r -> a) -> r -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> a
f)
{-# INLINE asks #-}
liftCallCC :: CallCC m a b -> CallCC (ReaderT r m) a b
liftCallCC :: CallCC m a b -> CallCC (ReaderT r m) a b
liftCallCC CallCC m a b
callCC (a -> ReaderT r m b) -> ReaderT r m a
f = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a) -> (r -> m a) -> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ \ r
r ->
CallCC m a b
callCC CallCC m a b -> CallCC m a b
forall a b. (a -> b) -> a -> b
$ \ a -> m b
c ->
ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ((a -> ReaderT r m b) -> ReaderT r m a
f ((r -> m b) -> ReaderT r m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m b) -> ReaderT r m b)
-> (a -> r -> m b) -> a -> ReaderT r m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m b -> r -> m b
forall a b. a -> b -> a
const (m b -> r -> m b) -> (a -> m b) -> a -> r -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
c)) r
r
{-# INLINE liftCallCC #-}
liftCatch :: Catch e m a -> Catch e (ReaderT r m) a
liftCatch :: Catch e m a -> Catch e (ReaderT r m) a
liftCatch Catch e m a
f ReaderT r m a
m e -> ReaderT r m a
h =
(r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a) -> (r -> m a) -> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ \ r
r -> Catch e m a
f (ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m r
r) (\ e
e -> ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (e -> ReaderT r m a
h e
e) r
r)
{-# INLINE liftCatch #-}