{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Safe #-}
#endif
#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE AutoDeriveTypeable #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Monad.Trans.Reader
-- Copyright   :  (c) Andy Gill 2001,
--                (c) Oregon Graduate Institute of Science and Technology, 2001
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  R.Paterson@city.ac.uk
-- Stability   :  experimental
-- Portability :  portable
--
-- Declaration of the 'ReaderT' monad transformer, which adds a static
-- environment to a given monad.
--
-- If the computation is to modify the stored information, use
-- "Control.Monad.Trans.State" instead.
-----------------------------------------------------------------------------

module Control.Monad.Trans.Reader (
    -- * The Reader monad
    Reader,
    reader,
    runReader,
    mapReader,
    withReader,
    -- * The ReaderT monad transformer
    ReaderT(..),
    mapReaderT,
    withReaderT,
    -- * Reader operations
    ask,
    local,
    asks,
    -- * Lifting other operations
    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 ()  -- deprecated from base-4.6
#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

-- | 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.
type Reader r = ReaderT r Identity

-- | Constructor for computations in the reader monad (equivalent to 'asks').
reader :: (Monad m) => (r -> a) -> ReaderT r m a
reader :: forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader r -> a
f = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> a
f)
{-# INLINE reader #-}

-- | Runs a @Reader@ and extracts the final value from it.
-- (The inverse of 'reader'.)
runReader
    :: Reader r a       -- ^ A @Reader@ to run.
    -> r                -- ^ An initial environment.
    -> a
runReader :: forall r a. Reader r a -> r -> a
runReader Reader r a
m = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Reader r a
m
{-# INLINE runReader #-}

-- | Transform the value returned by a @Reader@.
--
-- * @'runReader' ('mapReader' f m) = f . 'runReader' m@
mapReader :: (a -> b) -> Reader r a -> Reader r b
mapReader :: forall a b r. (a -> b) -> Reader r a -> Reader r b
mapReader a -> b
f = forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity)
{-# INLINE mapReader #-}

-- | Execute a computation in a modified environment
-- (a specialization of 'withReaderT').
--
-- * @'runReader' ('withReader' f m) = 'runReader' m . f@
withReader
    :: (r' -> r)        -- ^ The function to modify the environment.
    -> Reader r a       -- ^ Computation to run in the modified environment.
    -> Reader r' a
withReader :: forall r' r a. (r' -> r) -> Reader r a -> Reader r' a
withReader = forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
{-# INLINE withReader #-}

-- | 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.
newtype ReaderT r m a = ReaderT { forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT :: r -> m a }

-- | Transform the computation inside a @ReaderT@.
--
-- * @'runReaderT' ('mapReaderT' f m) = f . 'runReaderT' m@
mapReaderT :: (m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT :: forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m a -> n b
f ReaderT r m a
m = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ m a -> n b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m
{-# INLINE mapReaderT #-}

-- | Execute a computation in a modified environment
-- (a more general version of 'local').
--
-- * @'runReaderT' ('withReaderT' f m) = 'runReaderT' m . f@
withReaderT
    :: (r' -> r)        -- ^ The function to modify the environment.
    -> ReaderT r m a    -- ^ Computation to run in the modified environment.
    -> ReaderT r' m a
withReaderT :: forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT r' -> r
f ReaderT r m a
m = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. r' -> r
f
{-# INLINE withReaderT #-}

instance (Functor m) => Functor (ReaderT r m) where
    fmap :: forall a b. (a -> b) -> ReaderT r m a -> ReaderT r m b
fmap a -> b
f  = forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (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 <$ :: forall a b. a -> ReaderT r m b -> ReaderT r m a
<$ ReaderT r m b
v = forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (a
x 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 :: forall a. a -> ReaderT r m a
pure    = forall (m :: * -> *) a r. m a -> ReaderT r m a
liftReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE pure #-}
    ReaderT r m (a -> b)
f <*> :: forall a b. ReaderT r m (a -> b) -> ReaderT r m a -> ReaderT r m b
<*> ReaderT r m a
v = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \ r
r -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m (a -> b)
f r
r forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 *> :: forall a b. ReaderT r m a -> ReaderT r m b -> ReaderT r m b
*> ReaderT r m b
v = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \ r
r -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
u r
r forall (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 <* :: forall a b. ReaderT r m a -> ReaderT r m b -> ReaderT r m a
<* ReaderT r m b
v = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \ r
r -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
u r
r forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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 :: forall a b c.
(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 = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \ r
r -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
x r
r) (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 :: forall a. ReaderT r m a
empty   = forall (m :: * -> *) a r. m a -> ReaderT r m a
liftReaderT forall (f :: * -> *) a. Alternative f => f a
empty
    {-# INLINE empty #-}
    ReaderT r m a
m <|> :: forall a. ReaderT r m a -> ReaderT r m a -> ReaderT r m a
<|> ReaderT r m a
n = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \ r
r -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m r
r forall (f :: * -> *) a. Alternative f => f a -> f a -> f 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 >>= :: forall a b. ReaderT r m a -> (a -> ReaderT r m b) -> ReaderT r m b
>>= a -> ReaderT r m b
k  = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \ r
r -> do
        a
a <- forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m r
r
        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)
    >> :: forall a 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 :: forall a. String -> ReaderT r m a
fail String
msg = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
msg)
    {-# INLINE fail #-}
#endif

instance (MonadPlus m) => MonadPlus (ReaderT r m) where
    mzero :: forall a. ReaderT r m a
mzero       = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *) a. MonadPlus m => m a
mzero
    {-# INLINE mzero #-}
    ReaderT r m a
m mplus :: forall a. ReaderT r m a -> ReaderT r m a -> ReaderT r m a
`mplus` ReaderT r m a
n = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \ r
r -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m r
r forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` 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 :: forall a. (a -> ReaderT r m a) -> ReaderT r m a
mfix a -> ReaderT r m a
f = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \ r
r -> forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix forall a b. (a -> b) -> a -> b
$ \ a
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 :: forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
lift   = forall (m :: * -> *) a r. m a -> ReaderT r m a
liftReaderT
    {-# INLINE lift #-}

instance (MonadIO m) => MonadIO (ReaderT r m) where
    liftIO :: forall a. IO a -> ReaderT r m a
liftIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b c.
(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) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \ r
a ->
        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 :: forall a' a. (a' -> a) -> ReaderT r m a -> ReaderT r m a'
contramap a' -> a
f = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap a' -> a
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
    {-# INLINE contramap #-}
#endif

liftReaderT :: m a -> ReaderT r m a
liftReaderT :: forall (m :: * -> *) a r. m a -> ReaderT r m a
liftReaderT m a
m = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (forall a b. a -> b -> a
const m a
m)
{-# INLINE liftReaderT #-}

-- | Fetch the value of the environment.
ask :: (Monad m) => ReaderT r m r
ask :: forall (m :: * -> *) r. Monad m => ReaderT r m r
ask = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINE ask #-}

-- | Execute a computation in a modified environment
-- (a specialization of 'withReaderT').
--
-- * @'runReaderT' ('local' f m) = 'runReaderT' m . f@
local
    :: (r -> r)         -- ^ The function to modify the environment.
    -> ReaderT r m a    -- ^ Computation to run in the modified environment.
    -> ReaderT r m a
local :: forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local = forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
{-# INLINE local #-}

-- | Retrieve a function of the current environment.
--
-- * @'asks' f = 'liftM' f 'ask'@
asks :: (Monad m)
    => (r -> a)         -- ^ The selector function to apply to the environment.
    -> ReaderT r m a
asks :: forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks r -> a
f = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> a
f)
{-# INLINE asks #-}

-- | Lift a @callCC@ operation to the new monad.
liftCallCC :: CallCC m a b -> CallCC (ReaderT r m) a b
liftCallCC :: forall (m :: * -> *) a b r.
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 = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \ r
r ->
    CallCC m a b
callCC forall a b. (a -> b) -> a -> b
$ \ a -> m b
c ->
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ((a -> ReaderT r m b) -> ReaderT r m a
f (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
c)) r
r
{-# INLINE liftCallCC #-}

-- | Lift a @catchE@ operation to the new monad.
liftCatch :: Catch e m a -> Catch e (ReaderT r m) a
liftCatch :: forall e (m :: * -> *) a r. 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 =
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \ r
r -> Catch e m a
f (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m r
r) (\ e
e -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (e -> ReaderT r m a
h e
e) r
r)
{-# INLINE liftCatch #-}