@@ -26,39 +26,11 @@ module Control.Monad.Trans.Ether.State.Strict
2626 -- * State operations
2727 , get
2828 , put
29− -- * Newtype operations
30− , pack
31− , unpack
3229 ) where
3330
3431import Data.Functor.Identity (Identity(..))
35−import Control.Applicative
36−import Control.Monad (MonadPlus)
37−import Control.Monad.Fix (MonadFix)
38−import Control.Monad.Trans.Class (MonadTrans, lift)
39−import Control.Monad.IO.Class (MonadIO)
40−import Control.Monad.Morph (MFunctor)
41−import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
42−import GHC.Generics (Generic)
43−import Data.Coerce (coerce)
44−
45−import qualified Control.Monad.Base as MB
46−import qualified Control.Monad.Trans.Control as MC
4732import qualified Control.Monad.Trans.State.Strict as Trans
48−
49−import qualified Control.Monad.Trans.Lift.StT as Lift
50−import qualified Control.Monad.Trans.Lift.Local as Lift
51−import qualified Control.Monad.Trans.Lift.Catch as Lift
52−import qualified Control.Monad.Trans.Lift.Listen as Lift
53−import qualified Control.Monad.Trans.Lift.Pass as Lift
54−import qualified Control.Monad.Trans.Lift.CallCC as Lift
55−
56−import qualified Control.Monad.Cont.Class as Class
57−import qualified Control.Monad.Reader.Class as Class
58−import qualified Control.Monad.State.Class as Class
59−import qualified Control.Monad.Writer.Class as Class
60−import qualified Control.Monad.Error.Class as Class
61−
33+import Control.Ether.TT
6234
6335-- | The parametrizable state monad.
6436--
@@ -72,50 +44,7 @@ type State tag r = StateT tag r Identity
7244--
7345-- The 'return' function leaves the state unchanged, while '>>=' uses
7446-- the final state of the first computation as the initial state of the second.
75−newtype StateT tag s m a = StateT (Trans.StateT s m a)
76− deriving ( Generic
77− , Functor, Applicative, Alternative, Monad, MonadPlus
78− , MonadFix, MonadTrans, MonadIO, MFunctor
79− , MonadThrow, MonadCatch, MonadMask )
80−
81−-- | Type-restricted 'coerce'.
82−pack :: Trans.StateT s m a -> StateT tag s m a
83−pack = coerce
84−
85−-- | Type-restricted 'coerce'.
86−unpack :: StateT tag s m a -> Trans.StateT s m a
87−unpack = coerce
88−
89−instance MB.MonadBase b m => MB.MonadBase b (StateT tag s m) where
90− liftBase = MB.liftBaseDefault
91−
92−instance MC.MonadTransControl (StateT tag s) where
93− type StT (StateT tag s) a = MC.StT (Trans.StateT s) a
94− liftWith = MC.defaultLiftWith pack unpack
95− restoreT = MC.defaultRestoreT pack
96−
97−instance MC.MonadBaseControl b m => MC.MonadBaseControl b (StateT tag s m) where
98− type StM (StateT tag s m) a = MC.ComposeSt (StateT tag s) m a
99− liftBaseWith = MC.defaultLiftBaseWith
100− restoreM = MC.defaultRestoreM
101−
102−type instance Lift.StT (StateT tag s) a = MC.StT (StateT tag s) a
103−
104−instance Lift.LiftLocal (StateT tag s) where
105− liftLocal = Lift.defaultLiftLocal pack unpack
106−
107−instance Lift.LiftCatch (StateT tag s) where
108− liftCatch = Lift.defaultLiftCatch pack unpack
109−
110−instance Lift.LiftListen (StateT tag s) where
111− liftListen = Lift.defaultLiftListen pack unpack
112−
113−instance Lift.LiftPass (StateT tag s) where
114− liftPass = Lift.defaultLiftPass pack unpack
115−
116−instance Lift.LiftCallCC (StateT tag s) where
117− liftCallCC = Lift.defaultLiftCallCC pack unpack
118− liftCallCC' = Lift.defaultLiftCallCC' pack unpack
47+type StateT tag s = TT tag (Trans.StateT s)
11948
12049tagged :: proxy tag -> Trans.StateT s m a -> StateT tag s m a
12150tagged _ = pack
@@ -169,28 +98,3 @@ get t = tagged t Trans.get
16998-- | Set the value of the state within the monad.
17099put :: Monad m => proxy tag -> s -> StateT tag s m ()
171100put t = tagged t . Trans.put
172−
173−-- Instances for mtl classes
174−
175−instance Class.MonadCont m => Class.MonadCont (StateT tag s m) where
176− callCC = Lift.liftCallCC' Class.callCC
177−
178−instance Class.MonadReader r m => Class.MonadReader r (StateT tag s m) where
179− ask = lift Class.ask
180− local = Lift.liftLocal Class.ask Class.local
181− reader = lift . Class.reader
182−
183−instance Class.MonadState s' m => Class.MonadState s' (StateT tag s m) where
184− get = lift Class.get
185− put = lift . Class.put
186− state = lift . Class.state
187−
188−instance Class.MonadWriter w m => Class.MonadWriter w (StateT tag s m) where
189− writer = lift . Class.writer
190− tell = lift . Class.tell
191− listen = Lift.liftListen Class.listen
192− pass = Lift.liftPass Class.pass
193−
194−instance Class.MonadError e m => Class.MonadError e (StateT tag s m) where
195− throwError = lift . Class.throwError
196− catchError = Lift.liftCatch Class.catchError