{-# 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 { 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