@@ -29,9 +29,6 @@ module Control.Monad.Trans.Ether.State
2929 , liftCallCC'
3030 , liftListen
3131 , liftPass
32− -- * Wrapping operations
33− , tagWrap
34− , tagUnwrap
3532 ) where
3633
3734import Data.Proxy (Proxy(Proxy))
@@ -42,7 +39,7 @@ import Control.Monad (MonadPlus)
4239import Control.Monad.Fix (MonadFix)
4340import Control.Monad.Trans.Class (MonadTrans, lift)
4441import Control.Monad.IO.Class (MonadIO)
45−import Control.Ether.Tags (Tags)
42+import Control.Ether.Tags (Taggable(..), Tagged(..), Tags)
4643
4744import qualified Control.Monad.Signatures as Sig
4845import qualified Control.Monad.Trans.State.Lazy as Trans
@@ -72,84 +69,86 @@ newtype StateT tag s m a = StateT (Trans.StateT s m a)
7269 deriving ( Functor, Applicative, Alternative, Monad, MonadPlus
7370 , MonadFix, MonadTrans, MonadIO )
7471
75−type instance Tags (StateT tag r m) = tag ': Tags m
7672
77−tagWrap :: proxy tag -> Trans.StateT s m a -> StateT tag s m a
78−tagWrap _ = StateT
73+instance Taggable (StateT tag s m) where
74+ type Tag (StateT tag s m) = 'Just tag
75+ type Tags' (StateT tag s m) = Tags m
7976
80−tagUnwrap :: proxy tag -> StateT tag s m a -> Trans.StateT s m a
81−tagUnwrap _ (StateT a) = a
77+instance Tagged (StateT tag s m) tag where
78+ type Untagged (StateT tag s m) = Trans.StateT s m
79+ tagged _ = StateT
80+ untagged _ (StateT a) = a
8281
8382-- | Constructor for computations in the state monad transformer.
8483stateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a
85−stateT t = tagWrap t . Trans.StateT
84+stateT t = tagged t . Trans.StateT
8685
8786-- | Constructor for computations in the state monad
8887-- (the inverse of 'runState').
8988state :: Monad m => proxy tag -> (s -> (a, s)) -> StateT tag s m a
90−state t = tagWrap t . Trans.state
89+state t = tagged t . Trans.state
9190
9291-- | Runs a 'StateT' with the given initial state
9392-- and returns both the final value and the final state.
9493runStateT :: proxy tag -> StateT tag s m a -> s -> m (a, s)
95−runStateT t = Trans.runStateT . tagUnwrap t
94+runStateT t = Trans.runStateT . untagged t
9695
9796-- | Runs a 'StateT' with the given initial state
9897-- and returns the final value, discarding the final state.
9998evalStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m a
100−evalStateT t = Trans.evalStateT . tagUnwrap t
99+evalStateT t = Trans.evalStateT . untagged t
101100
102101-- | Runs a 'StateT' with the given initial state
103102-- and returns the final state, discarding the final value.
104103execStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m s
105−execStateT t = Trans.execStateT . tagUnwrap t
104+execStateT t = Trans.execStateT . untagged t
106105
107106-- | Runs a 'State' with the given initial state
108107-- and returns both the final value and the final state.
109108runState :: proxy tag -> State tag s a -> s -> (a, s)
110−runState t = Trans.runState . tagUnwrap t
109+runState t = Trans.runState . untagged t
111110
112111-- | Runs a 'State' with the given initial state
113112-- and returns the final value, discarding the final state.
114113evalState :: proxy tag -> State tag s a -> s -> a
115−evalState t = Trans.evalState . tagUnwrap t
114+evalState t = Trans.evalState . untagged t
116115
117116-- | Runs a 'State' with the given initial state
118117-- and returns the final state, discarding the final value.
119118execState :: proxy tag -> State tag s a -> s -> s
120−execState t = Trans.execState . tagUnwrap t
119+execState t = Trans.execState . untagged t
121120
122121-- | Transform the computation inside a 'StateT'.
123122--
124123-- * @'runStateT' tag ('mapStateT' tag f m) = f . 'runStateT' tag m@
125124mapStateT :: proxy tag -> (m (a, s) -> n (b, s)) -> StateT tag s m a -> StateT tag s n b
126−mapStateT t f m = tagWrap t $ Trans.mapStateT f (coerce m)
125+mapStateT t f m = tagged t $ Trans.mapStateT f (coerce m)
127126
128127-- | Fetch the current value of the state within the monad.
129128get :: Monad m => proxy tag -> StateT tag s m s
130−get t = tagWrap t Trans.get
129+get t = tagged t Trans.get
131130
132131-- | Set the value of the state within the monad.
133132put :: Monad m => proxy tag -> s -> StateT tag s m ()
134−put t = tagWrap t . Trans.put
133+put t = tagged t . Trans.put
135134
136135-- | Lift a @catchE@ operation to the new monad.
137136liftCatch :: proxy tag -> Sig.Catch e m (a, s) -> Sig.Catch e (StateT tag s m) a
138−liftCatch t f m h = tagWrap t $ Trans.liftCatch f (coerce m) (coerce h)
137+liftCatch t f m h = tagged t $ Trans.liftCatch f (coerce m) (coerce h)
139138
140139-- | Lift a @listen@ operation to the new monad.
141140liftListen :: Monad m => proxy tag -> Sig.Listen w m (a, s) -> Sig.Listen w (StateT tag s m) a
142−liftListen t listen m = tagWrap t $ Trans.liftListen listen (coerce m)
141+liftListen t listen m = tagged t $ Trans.liftListen listen (coerce m)
143142
144143-- | In-situ lifting of a @callCC@ operation to the new monad.
145144-- This version uses the current state on entering the continuation.
146145-- It does not satisfy the uniformity property (see "Control.Monad.Signatures").
147146liftCallCC' :: proxy tag -> Sig.CallCC m (a, s) (b, s) -> Sig.CallCC (StateT tag s m) a b
148−liftCallCC' t callCC f = tagWrap t $ Trans.liftCallCC' callCC (coerce f)
147+liftCallCC' t callCC f = tagged t $ Trans.liftCallCC' callCC (coerce f)
149148
150149-- | Lift a @pass@ operation to the new monad.
151150liftPass :: Monad m => proxy tag -> Sig.Pass w m (a,s) -> Sig.Pass w (StateT tag s m) a
152−liftPass t pass m = tagWrap t $ Trans.liftPass pass (coerce m)
151+liftPass t pass m = tagged t $ Trans.liftPass pass (coerce m)
153152
154153-- Instances for mtl classes
155154