-- |
-- The Reader monad transformer.
--
-- This is useful to keep a non-modifiable value
-- in a context
{-# LANGUAGE ConstraintKinds #-}
module Foundation.Monad.Reader
    ( -- * MonadReader
      MonadReader(..)
    , -- * ReaderT
      ReaderT
    , runReaderT
    ) where

import Basement.Compat.Base (($), (.), const)
import Foundation.Monad.Base
import Foundation.Monad.Exception

class Monad m => MonadReader m where
    type ReaderContext m
    ask :: m (ReaderContext m)

-- | Reader Transformer
newtype ReaderT r m a = ReaderT { forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT :: r -> m a }

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 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m
    {-# INLINE fmap #-}

instance Applicative m => Applicative (ReaderT r m) where
    pure :: forall a. a -> ReaderT r m a
pure a
a     = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
    {-# INLINE pure #-}
    ReaderT r m (a -> b)
fab <*> :: forall a b. ReaderT r m (a -> b) -> ReaderT r m a -> ReaderT r m b
<*> ReaderT r m a
fa = 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)
fab 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
fa r
r
    {-# INLINE (<*>) #-}

instance Monad m => Monad (ReaderT r m) where
    return :: forall a. a -> ReaderT r m a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE return #-}
    ReaderT r m a
ma >>= :: forall a b. ReaderT r m a -> (a -> ReaderT r m b) -> ReaderT r m b
>>= a -> ReaderT r m b
mab = 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
ma r
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (a -> ReaderT r m b
mab a
a) r
r
    {-# INLINE (>>=) #-}

instance (Monad m, MonadFix m) => MonadFix (ReaderT s m) where
    mfix :: forall a. (a -> ReaderT s m a) -> ReaderT s m a
mfix a -> ReaderT s m a
f = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \s
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 s m a
f a
a) s
r
    {-# INLINE mfix #-}

instance MonadTrans (ReaderT r) where
    lift :: forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
lift m a
f = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const m a
f
    {-# INLINE lift #-}

instance MonadIO m => MonadIO (ReaderT r m) where
    liftIO :: forall a. IO a -> ReaderT r m a
liftIO IO a
f = forall (trans :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans trans, Monad m) =>
m a -> trans m a
lift (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
f)
    {-# INLINE liftIO #-}

instance MonadFailure m => MonadFailure (ReaderT r m) where
    type Failure (ReaderT r m) = Failure m
    mFail :: Failure (ReaderT r m) -> ReaderT r m ()
mFail Failure (ReaderT r m)
e = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
_ -> forall (m :: * -> *). MonadFailure m => Failure m -> m ()
mFail Failure (ReaderT r m)
e

instance MonadThrow m => MonadThrow (ReaderT r m) where
    throw :: forall e a. Exception e => e -> ReaderT r m a
throw e
e = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
_ -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw e
e

instance MonadCatch m => MonadCatch (ReaderT r m) where
    catch :: forall e a.
Exception e =>
ReaderT r m a -> (e -> ReaderT r m a) -> ReaderT r m a
catch (ReaderT r -> m a
m) e -> ReaderT r m a
c = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> r -> m a
m r
r forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\e
e -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (e -> ReaderT r m a
c e
e) r
r)

instance MonadBracket m => MonadBracket (ReaderT r m) where
    generalBracket :: forall a b ignored1 ignored2.
ReaderT r m a
-> (a -> b -> ReaderT r m ignored1)
-> (a -> SomeException -> ReaderT r m ignored2)
-> (a -> ReaderT r m b)
-> ReaderT r m b
generalBracket ReaderT r m a
acq a -> b -> ReaderT r m ignored1
cleanup a -> SomeException -> ReaderT r m ignored2
cleanupExcept a -> ReaderT r m b
innerAction = do
        r
c <- forall (m :: * -> *). MonadReader m => m (ReaderContext m)
ask
        forall (trans :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans trans, Monad m) =>
m a -> trans m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b ignored1 ignored2.
MonadBracket m =>
m a
-> (a -> b -> m ignored1)
-> (a -> SomeException -> m ignored2)
-> (a -> m b)
-> m b
generalBracket (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
acq r
c)
                              (\a
a b
b -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (a -> b -> ReaderT r m ignored1
cleanup a
a b
b) r
c)
                              (\a
a SomeException
exn -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (a -> SomeException -> ReaderT r m ignored2
cleanupExcept a
a SomeException
exn) r
c)
                              (\a
a -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (a -> ReaderT r m b
innerAction a
a) r
c)

instance Monad m => MonadReader (ReaderT r m) where
    type ReaderContext (ReaderT r m) = r
    ask :: ReaderT r m (ReaderContext (ReaderT r m))
ask = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall (m :: * -> *) a. Monad m => a -> m a
return