{-# LANGUAGE TemplateHaskell #-}
module Control.Effect.Reader
(
Reader'(..)
, asks'
, Reader
, ask
, local
, reader
, asks
, runReader'
, runReader
, tagReader'
, retagReader'
, untagReader'
) where
import qualified Control.Monad.Trans.Reader as R
import qualified Control.Monad.Trans.RWS.CPS as Strict
import qualified Control.Monad.Trans.RWS.Lazy as Lazy
import Control.Effect.Machinery
class Monad m => Reader' tag r m | tag m -> r where
{-# MINIMAL (ask' | reader'), local' #-}
ask' :: m r
ask' = (r -> r) -> m r
forall k (tag :: k) r (m :: * -> *) a.
Reader' tag r m =>
(r -> a) -> m a
reader' @tag r -> r
forall a. a -> a
id
{-# INLINE ask' #-}
local' :: (r -> r)
-> m a
-> m a
reader' :: (r -> a)
-> m a
reader' r -> a
f = do
r
r <- forall k (tag :: k) r (m :: * -> *). Reader' tag r m => m r
forall r (m :: * -> *). Reader' tag r m => m r
ask' @tag
a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (r -> a
f r
r)
{-# INLINE reader' #-}
makeTaggedEffect ''Reader'
instance Monad m => Reader' tag r (R.ReaderT r m) where
ask' :: ReaderT r m r
ask' = ReaderT r m r
forall (m :: * -> *) r. Monad m => ReaderT r m r
R.ask
{-# INLINE ask' #-}
local' :: (r -> r) -> ReaderT r m a -> ReaderT r m a
local' = (r -> r) -> ReaderT r m a -> ReaderT r m a
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
R.local
{-# INLINE local' #-}
reader' :: (r -> a) -> ReaderT r m a
reader' = (r -> a) -> ReaderT r m a
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
R.reader
{-# INLINE reader' #-}
instance (Monad m, Monoid w) => Reader' tag r (Lazy.RWST r w s m) where
ask' :: RWST r w s m r
ask' = RWST r w s m r
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
Lazy.ask
{-# INLINE ask' #-}
local' :: (r -> r) -> RWST r w s m a -> RWST r w s m a
local' = (r -> r) -> RWST r w s m a -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> r) -> RWST r w s m a -> RWST r w s m a
Lazy.local
{-# INLINE local' #-}
reader' :: (r -> a) -> RWST r w s m a
reader' = (r -> a) -> RWST r w s m a
forall w (m :: * -> *) r a s.
(Monoid w, Monad m) =>
(r -> a) -> RWST r w s m a
Lazy.reader
{-# INLINE reader' #-}
instance Monad m => Reader' tag r (Strict.RWST r w s m) where
ask' :: RWST r w s m r
ask' = RWST r w s m r
forall (m :: * -> *) r w s. Monad m => RWST r w s m r
Strict.ask
{-# INLINE ask' #-}
local' :: (r -> r) -> RWST r w s m a -> RWST r w s m a
local' = (r -> r) -> RWST r w s m a -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> r) -> RWST r w s m a -> RWST r w s m a
Strict.local
{-# INLINE local' #-}
reader' :: (r -> a) -> RWST r w s m a
reader' = (r -> a) -> RWST r w s m a
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
Strict.reader
{-# INLINE reader' #-}
asks' :: forall tag r m a. Reader' tag r m
=> (r -> a)
-> m a
asks' :: (r -> a) -> m a
asks' = forall k (tag :: k) r (m :: * -> *) a.
Reader' tag r m =>
(r -> a) -> m a
forall r (m :: * -> *) a. Reader' tag r m => (r -> a) -> m a
reader' @tag
{-# INLINE asks' #-}
makeUntagged ['asks']
runReader' :: forall tag r m a. r
-> (Reader' tag r `Via` R.ReaderT r) m a
-> m a
runReader' :: r -> Via (Reader' tag r) (ReaderT r) m a -> m a
runReader' r
r = (ReaderT r m a -> r -> m a) -> r -> ReaderT r m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT r
r (ReaderT r m a -> m a)
-> (Via (Reader' tag r) (ReaderT r) m a -> ReaderT r m a)
-> Via (Reader' tag r) (ReaderT r) m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Via (Reader' tag r) (ReaderT r) m a -> ReaderT r m a
forall (effs :: [Effect]) (t :: Transformer) (m :: * -> *) a.
EachVia effs t m a -> t m a
runVia
{-# INLINE runReader' #-}
makeUntagged ['runReader']