module Control.Monad.Trans.Ether.State.Strict
(
State
, state
, runState
, evalState
, execState
, StateT
, stateT
, runStateT
, evalStateT
, execStateT
, get
, put
) 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)
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.State.Strict 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 State tag r = StateT tag r Identity
newtype StateT tag s m a = StateT (Trans.StateT s m a)
deriving ( Generic
, Functor, Applicative, Alternative, Monad, MonadPlus
, MonadFix, MonadTrans, MonadIO, MFunctor )
instance NT.Newtype (StateT tag s m a)
instance MB.MonadBase b m => MB.MonadBase b (StateT tag s m) where
liftBase = MB.liftBaseDefault
instance MC.MonadTransControl (StateT tag s) where
type StT (StateT tag s) a = MC.StT (Trans.StateT s) a
liftWith = MC.defaultLiftWith NT.pack NT.unpack
restoreT = MC.defaultRestoreT NT.pack
instance MC.MonadBaseControl b m => MC.MonadBaseControl b (StateT tag s m) where
type StM (StateT tag s m) a = MC.ComposeSt (StateT tag s) m a
liftBaseWith = MC.defaultLiftBaseWith
restoreM = MC.defaultRestoreM
type instance Lift.StT (StateT tag s) a = MC.StT (StateT tag s) a
instance Lift.LiftLocal (StateT tag s) where
liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack
instance Lift.LiftCatch (StateT tag s) where
liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack
instance Lift.LiftListen (StateT tag s) where
liftListen = Lift.defaultLiftListen NT.pack NT.unpack
instance Lift.LiftPass (StateT tag s) where
liftPass = Lift.defaultLiftPass NT.pack NT.unpack
instance Lift.LiftCallCC (StateT tag s) where
liftCallCC = Lift.defaultLiftCallCC NT.pack NT.unpack
liftCallCC' = Lift.defaultLiftCallCC' NT.pack NT.unpack
instance Taggable (StateT tag s m) where
type Tag (StateT tag s m) = 'Just tag
type Inner (StateT tag s m) = 'Just m
instance Tagged (StateT tag s m) tag where
type Untagged (StateT tag s m) = Trans.StateT s m
stateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a
stateT t = tagged t . Trans.StateT
state :: Monad m => proxy tag -> (s -> (a, s)) -> StateT tag s m a
state t = tagged t . Trans.state
runStateT :: proxy tag -> StateT tag s m a -> s -> m (a, s)
runStateT t = Trans.runStateT . untagged t
evalStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m a
evalStateT t = Trans.evalStateT . untagged t
execStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m s
execStateT t = Trans.execStateT . untagged t
runState :: proxy tag -> State tag s a -> s -> (a, s)
runState t = Trans.runState . untagged t
evalState :: proxy tag -> State tag s a -> s -> a
evalState t = Trans.evalState . untagged t
execState :: proxy tag -> State tag s a -> s -> s
execState t = Trans.execState . untagged t
get :: Monad m => proxy tag -> StateT tag s m s
get t = tagged t Trans.get
put :: Monad m => proxy tag -> s -> StateT tag s m ()
put t = tagged t . Trans.put
instance Class.MonadCont m => Class.MonadCont (StateT tag s m) where
callCC = Lift.liftCallCC' Class.callCC
instance Class.MonadReader r m => Class.MonadReader r (StateT tag s 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' (StateT tag s m) where
get = lift Class.get
put = lift . Class.put
state = lift . Class.state
instance Class.MonadWriter w m => Class.MonadWriter w (StateT tag s 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 (StateT tag s m) where
throwError = lift . Class.throwError
catchError = Lift.liftCatch Class.catchError