module Control.Monad.Trans.Ether.Reader
(
Reader
, reader
, runReader
, ReaderT
, readerT
, runReaderT
, ask
, local
) where
import Data.Functor.Identity (Identity(..))
import Control.Applicative
import Control.Monad (MonadPlus)
import Control.Monad.Fix (MonadFix)
import Control.Monad.Trans.Class (MonadTrans, lift)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Morph (MFunctor, MMonad)
import Control.Ether.Tagged (Taggable(..), Tagged(..))
import GHC.Generics (Generic)
import qualified Control.Newtype as NT
import qualified Control.Monad.Base as MB
import qualified Control.Monad.Trans.Control as MC
import qualified Control.Monad.Trans.Reader as Trans
import qualified Control.Monad.Trans.Lift.StT as Lift
import qualified Control.Monad.Trans.Lift.Local as Lift
import qualified Control.Monad.Trans.Lift.Catch as Lift
import qualified Control.Monad.Trans.Lift.Listen as Lift
import qualified Control.Monad.Trans.Lift.Pass as Lift
import qualified Control.Monad.Trans.Lift.CallCC as Lift
import qualified Control.Monad.Cont.Class as Class
import qualified Control.Monad.Reader.Class as Class
import qualified Control.Monad.State.Class as Class
import qualified Control.Monad.Writer.Class as Class
import qualified Control.Monad.Error.Class as Class
type Reader tag r = ReaderT tag r Identity
newtype ReaderT tag r m a = ReaderT (Trans.ReaderT r m a)
deriving ( Generic
, Functor, Applicative, Alternative, Monad, MonadPlus
, MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
instance NT.Newtype (ReaderT tag r m a)
instance MB.MonadBase b m => MB.MonadBase b (ReaderT tag r m) where
liftBase = MB.liftBaseDefault
instance MC.MonadTransControl (ReaderT tag r) where
type StT (ReaderT tag r) a = MC.StT (Trans.ReaderT r) a
liftWith = MC.defaultLiftWith NT.pack NT.unpack
restoreT = MC.defaultRestoreT NT.pack
instance MC.MonadBaseControl b m => MC.MonadBaseControl b (ReaderT tag r m) where
type StM (ReaderT tag r m) a = MC.ComposeSt (ReaderT tag r) m a
liftBaseWith = MC.defaultLiftBaseWith
restoreM = MC.defaultRestoreM
type instance Lift.StT (ReaderT tag r) a = MC.StT (ReaderT tag r) a
instance Lift.LiftLocal (ReaderT tag r) where
liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack
instance Lift.LiftCatch (ReaderT tag r) where
liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack
instance Lift.LiftListen (ReaderT tag r) where
liftListen = Lift.defaultLiftListen NT.pack NT.unpack
instance Lift.LiftPass (ReaderT tag r) where
liftPass = Lift.defaultLiftPass NT.pack NT.unpack
instance Lift.LiftCallCC (ReaderT tag r) where
liftCallCC = Lift.defaultLiftCallCC NT.pack NT.unpack
liftCallCC' = Lift.defaultLiftCallCC' NT.pack NT.unpack
instance Taggable (ReaderT tag r m) where
type Tag (ReaderT tag r m) = 'Just tag
type Inner (ReaderT tag r m) = 'Just m
instance Tagged (ReaderT tag r m) tag where
type Untagged (ReaderT tag r m) = Trans.ReaderT r m
readerT :: proxy tag -> (r -> m a) -> ReaderT tag r m a
readerT t = tagged t . Trans.ReaderT
reader :: Monad m => proxy tag -> (r -> a) -> ReaderT tag r m a
reader t = tagged t . Trans.reader
runReaderT :: proxy tag -> ReaderT tag r m a -> r -> m a
runReaderT t = Trans.runReaderT . untagged t
runReader :: proxy tag -> Reader tag r a -> r -> a
runReader t = Trans.runReader . untagged t
ask :: Monad m => proxy tag -> ReaderT tag r m r
ask t = tagged t Trans.ask
local
:: proxy tag
-> (r -> r)
-> ReaderT tag r m a
-> ReaderT tag r m a
local t f m = tagged t $ Trans.withReaderT f (untagged t m)
instance Class.MonadCont m => Class.MonadCont (ReaderT tag r m) where
callCC = Lift.liftCallCC Class.callCC
instance Class.MonadReader r' m => Class.MonadReader r' (ReaderT tag r m) where
ask = lift Class.ask
local = Lift.liftLocal Class.ask Class.local
reader = lift . Class.reader
instance Class.MonadState s m => Class.MonadState s (ReaderT tag r m) where
get = lift Class.get
put = lift . Class.put
state = lift . Class.state
instance Class.MonadWriter w m => Class.MonadWriter w (ReaderT tag r m) where
writer = lift . Class.writer
tell = lift . Class.tell
listen = Lift.liftListen Class.listen
pass = Lift.liftPass Class.pass
instance Class.MonadError e m => Class.MonadError e (ReaderT tag r m) where
throwError = lift . Class.throwError
catchError = Lift.liftCatch Class.catchError