-- |
-- 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 { ReaderT r m a -> r -> m a
runReaderT :: r -> m a }

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

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

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

instance MonadIO m => MonadIO (ReaderT r m) where
    liftIO :: IO a -> ReaderT r m a
liftIO IO a
f = m a -> ReaderT r m a
forall (trans :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans trans, Monad m) =>
m a -> trans m a
lift (IO a -> m a
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 = (r -> m ()) -> ReaderT r m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m ()) -> ReaderT r m ()) -> (r -> m ()) -> ReaderT r m ()
forall a b. (a -> b) -> a -> b
$ \r
_ -> Failure m -> m ()
forall (m :: * -> *). MonadFailure m => Failure m -> m ()
mFail Failure m
Failure (ReaderT r m)
e

instance MonadThrow m => MonadThrow (ReaderT r m) where
    throw :: e -> ReaderT r m a
throw e
e = (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
_ -> e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw e
e

instance MonadCatch m => MonadCatch (ReaderT r m) where
    catch :: 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 = (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 -> r -> m a
m r
r m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\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
c e
e) r
r)

instance MonadBracket m => MonadBracket (ReaderT r m) where
    generalBracket :: 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 <- ReaderT r m r
forall (m :: * -> *). MonadReader m => m (ReaderContext m)
ask
        m b -> ReaderT r m b
forall (trans :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans trans, Monad m) =>
m a -> trans m a
lift (m b -> ReaderT r m b) -> m b -> ReaderT r m b
forall a b. (a -> b) -> a -> b
$ m a
-> (a -> b -> m ignored1)
-> (a -> SomeException -> m ignored2)
-> (a -> m b)
-> m 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 (ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
acq r
c)
                              (\a
a b
b -> ReaderT r m ignored1 -> r -> m ignored1
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 -> ReaderT r m ignored2 -> r -> m ignored2
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 -> ReaderT r m b -> r -> m b
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 = (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