{-# LANGUAGE ConstraintKinds #-}
module Foundation.Monad.Reader
(
MonadReader(..)
,
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)
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