git.iko.soy/typeable/ether
on master help sign in
Rename Handler back to TaggedTrans
commitd24e51a39952ea4072b9375b85dfe8e42d55439d authorVladislav Zavialov <vlad.z.4096@gmail.com> dateFri 28 Apr 2017, 11:06 (9 years ago) parentd7afb54
9 files changed+113−108
compare with master
unifiedsplit
CHANGELOG.md+1−1 ether.cabal+1−1 src/Ether.hs+2−2 src/Ether/Except.hs+6−6 src/Ether/Reader.hs+17−17 src/Ether/State.hs+22−22 src/Ether/TagDispatch.hs+11−11 src/Ether/Handler.hs → src/Ether/TaggedTrans.hs+47−42 src/Ether/Writer.hs+6−6
CHANGELOG.md+1−1
@@ -5,7 +5,7 @@
55* Use the `TypeApplications` extension to get rid of `Proxy`.
66* Remove `Control.Ether.TH`.
77* Remove `Control.Ether.Abbr`.
8−* Unify `Dispatch` and `TaggedTrans` as `Handler`.
8+* Unify `Dispatch` and `TaggedTrans`.
99* Better `MonadBase` and `MonadBaseControl` instances.
1010* Add flattening for `ReaderT` and `StateT`.
1111* Add zooming for `MonadState`.
ether.cabal+1−1
@@ -32,7 +32,7 @@ library
3232 Ether.State
3333 Ether.Writer
3434 Ether.Except
35− Ether.Handler
35+ Ether.TaggedTrans
3636 Ether.TagDispatch
3737 Ether.Internal
3838
src/Ether.hs+2−2
@@ -9,7 +9,7 @@ module Ether
99 , module Ether.State
1010 , module Ether.Except
1111 , module Ether.TagDispatch
12− , module Ether.Handler
12+ , module Ether.TaggedTrans
1313 ) where
1414
1515import Control.Monad
@@ -22,4 +22,4 @@ import Ether.Writer
2222import Ether.State
2323import Ether.Except
2424import Ether.TagDispatch
25−import Ether.Handler
25+import Ether.TaggedTrans
src/Ether/Except.hs+6−6
@@ -33,7 +33,7 @@ import qualified Control.Monad.Trans.Lift.Catch as Lift
3333import Data.Coerce
3434import Data.Functor.Identity
3535
36−import Ether.Handler
36+import Ether.TaggedTrans
3737import Ether.Internal
3838
3939class Monad m => MonadExcept tag e m | m tag -> e where
@@ -41,7 +41,7 @@ class Monad m => MonadExcept tag e m | m tag -> e where
4141 -- | Is used within a monadic computation to begin exception processing.
4242 throw :: e -> m a
4343
44− -- | A handler function to handle previous exceptions and return to
44+ -- | A TaggedTrans function to handle previous exceptions and return to
4545 -- normal execution.
4646 catch :: m a -> (e -> m a) -> m a
4747
@@ -72,7 +72,7 @@ type Except tag e = ExceptT tag e Identity
7272--
7373-- The 'return' function returns a normal value, while '>>=' exits on
7474-- the first exception.
75−type ExceptT tag e = Handler (TAGGED EXCEPT tag) (T.ExceptT e)
75+type ExceptT tag e = TaggedTrans (TAGGED EXCEPT tag) (T.ExceptT e)
7676
7777-- | Runs an 'Except' and returns either an exception or a normal value.
7878runExcept :: forall tag e a . Except tag e a -> Either e a
@@ -100,18 +100,18 @@ instance Handle EXCEPT e (T.ExceptT e) where
100100instance
101101 ( Handle EXCEPT e trans
102102 , Monad m, Monad (trans m)
103− ) => MonadExcept tag e (Handler (TAGGED EXCEPT tag) trans m)
103+ ) => MonadExcept tag e (TaggedTrans (TAGGED EXCEPT tag) trans m)
104104 where
105105 throw =
106106 handling @EXCEPT @e @trans @m $
107107 coerce (T.throwError @e @(trans m) @a) ::
108− forall eff a . e -> Handler eff trans m a
108+ forall eff a . e -> TaggedTrans eff trans m a
109109 {-# INLINE throw #-}
110110
111111 catch =
112112 handling @EXCEPT @e @trans @m $
113113 coerce (T.catchError @e @(trans m) @a) ::
114− forall eff a . Catch e (Handler eff trans m) a
114+ forall eff a . Catch e (TaggedTrans eff trans m) a
115115 {-# INLINE catch #-}
116116
117117type MonadExcept' e = MonadExcept e e
src/Ether/Reader.hs+17−17
@@ -45,7 +45,7 @@ import Data.Coerce
4545import Data.Functor.Identity
4646import Data.Kind
4747
48−import Ether.Handler
48+import Ether.TaggedTrans
4949import Ether.Internal
5050
5151class Monad m => MonadReader tag r m | m tag -> r where
@@ -89,28 +89,28 @@ instance {-# OVERLAPPABLE #-}
8989
9090instance {-# OVERLAPPABLE #-}
9191 ( Monad (trans m)
92− , MonadReader tag r (Handler effs trans m)
93− ) => MonadReader tag r (Handler (eff ': effs) trans (m :: Type -> Type))
92+ , MonadReader tag r (TaggedTrans effs trans m)
93+ ) => MonadReader tag r (TaggedTrans (eff ': effs) trans (m :: Type -> Type))
9494 where
9595
9696 ask =
9797 (coerce ::
98− Handler effs trans m r ->
99− Handler (eff ': effs) trans m r)
98+ TaggedTrans effs trans m r ->
99+ TaggedTrans (eff ': effs) trans m r)
100100 (ask @tag)
101101 {-# INLINE ask #-}
102102
103103 local =
104104 (coerce :: forall a .
105− Lift.Local r (Handler effs trans m) a ->
106− Lift.Local r (Handler (eff ': effs) trans m) a)
105+ Lift.Local r (TaggedTrans effs trans m) a ->
106+ Lift.Local r (TaggedTrans (eff ': effs) trans m) a)
107107 (local @tag)
108108 {-# INLINE local #-}
109109
110110 reader =
111111 (coerce :: forall a .
112− ((r -> a) -> Handler effs trans m a) ->
113− ((r -> a) -> Handler (eff ': effs) trans m a))
112+ ((r -> a) -> TaggedTrans effs trans m a) ->
113+ ((r -> a) -> TaggedTrans (eff ': effs) trans m a))
114114 (reader @tag)
115115 {-# INLINE reader #-}
116116
@@ -140,7 +140,7 @@ type Reader tag r = ReaderT tag r Identity
140140--
141141-- The 'return' function ignores the environment, while '>>=' passes
142142-- the inherited environment to both subcomputations.
143−type ReaderT tag r = Handler (TAGGED READER tag) (T.ReaderT r)
143+type ReaderT tag r = TaggedTrans (TAGGED READER tag) (T.ReaderT r)
144144
145145-- | Constructor for computations in the reader monad transformer.
146146readerT :: forall tag r m a . (r -> m a) -> ReaderT tag r m a
@@ -170,7 +170,7 @@ instance Handle READER r (T.ReaderT r) where
170170instance
171171 ( Handle READER r trans
172172 , Monad m, Monad (trans m)
173− ) => MonadReader tag r (Handler (TAGGED READER tag) trans m)
173+ ) => MonadReader tag r (TaggedTrans (TAGGED READER tag) trans m)
174174 where
175175
176176 ask =
@@ -181,27 +181,27 @@ instance
181181 local =
182182 handling @READER @r @trans @m $
183183 coerce (T.local @r @(trans m) @a) ::
184− forall eff a . Local r (Handler eff trans m) a
184+ forall eff a . Local r (TaggedTrans eff trans m) a
185185 {-# INLINE local #-}
186186
187187 reader =
188188 handling @READER @r @trans @m $
189189 coerce (T.reader @r @(trans m) @a) ::
190− forall eff a . (r -> a) -> Handler eff trans m a
190+ forall eff a . (r -> a) -> TaggedTrans eff trans m a
191191 {-# INLINE reader #-}
192192
193193instance
194194 ( HasLens tag payload r
195195 , Handle READER payload trans
196196 , Monad m, Monad (trans m)
197− ) => MonadReader tag r (Handler (TAGGED READER tag ': effs) trans m)
197+ ) => MonadReader tag r (TaggedTrans (TAGGED READER tag ': effs) trans m)
198198 where
199199
200200 ask =
201201 handling @READER @payload @trans @m $
202202 (coerce :: forall eff a .
203203 trans m a ->
204− Handler eff trans m a)
204+ TaggedTrans eff trans m a)
205205 (T.asks (view (lensOf @tag @payload @r)))
206206 {-# INLINE ask #-}
207207
@@ -209,7 +209,7 @@ instance
209209 handling @READER @payload @trans @m $
210210 (coerce :: forall eff a .
211211 (trans m a -> trans m a) ->
212− (Handler eff trans m a -> Handler eff trans m a))
212+ (TaggedTrans eff trans m a -> TaggedTrans eff trans m a))
213213 (T.local (over (lensOf @tag @payload @r) f))
214214 {-# INLINE local #-}
215215
@@ -217,7 +217,7 @@ type family READERS (ts :: HList xs) :: [Type] where
217217 READERS 'HNil = '[]
218218 READERS ('HCons t ts) = TAGGED READER t ': READERS ts
219219
220−type ReadersT r = Handler (READERS (Tags r)) (T.ReaderT r)
220+type ReadersT r = TaggedTrans (READERS (Tags r)) (T.ReaderT r)
221221
222222type Readers r = ReadersT r Identity
223223
src/Ether/State.hs+22−22
@@ -85,7 +85,7 @@ import Data.Kind
8585import Data.Proxy
8686import Data.Reflection
8787
88−import Ether.Handler
88+import Ether.TaggedTrans
8989import Ether.Internal
9090
9191class Monad m => MonadState tag s m | m tag -> s where
@@ -126,28 +126,28 @@ instance {-# OVERLAPPABLE #-}
126126
127127instance {-# OVERLAPPABLE #-}
128128 ( Monad (trans m)
129− , MonadState tag s (Handler effs trans m)
130− ) => MonadState tag s (Handler (eff ': effs) trans (m :: Type -> Type))
129+ , MonadState tag s (TaggedTrans effs trans m)
130+ ) => MonadState tag s (TaggedTrans (eff ': effs) trans (m :: Type -> Type))
131131 where
132132
133133 get =
134134 (coerce ::
135− Handler effs trans m s ->
136− Handler (eff ': effs) trans m s)
135+ TaggedTrans effs trans m s ->
136+ TaggedTrans (eff ': effs) trans m s)
137137 (get @tag)
138138 {-# INLINE get #-}
139139
140140 put =
141141 (coerce ::
142− (s -> Handler effs trans m ()) ->
143− (s -> Handler (eff ': effs) trans m ()))
142+ (s -> TaggedTrans effs trans m ()) ->
143+ (s -> TaggedTrans (eff ': effs) trans m ()))
144144 (put @tag)
145145 {-# INLINE put #-}
146146
147147 state =
148148 (coerce :: forall a .
149− ((s -> (a, s)) -> Handler effs trans m a) ->
150− ((s -> (a, s)) -> Handler (eff ': effs) trans m a))
149+ ((s -> (a, s)) -> TaggedTrans effs trans m a) ->
150+ ((s -> (a, s)) -> TaggedTrans (eff ': effs) trans m a))
151151 (state @tag)
152152 {-# INLINE state #-}
153153
@@ -179,7 +179,7 @@ instance Handle STATE s (T.Lazy.StateT s) where
179179instance
180180 ( Handle STATE s trans
181181 , Monad m, Monad (trans m)
182− ) => MonadState tag s (Handler (TAGGED STATE tag) trans m)
182+ ) => MonadState tag s (TaggedTrans (TAGGED STATE tag) trans m)
183183 where
184184
185185 get =
@@ -195,21 +195,21 @@ instance
195195 state =
196196 handling @STATE @s @trans @m $
197197 coerce (T.state @s @(trans m) @a) ::
198− forall eff a . (s -> (a, s)) -> Handler eff trans m a
198+ forall eff a . (s -> (a, s)) -> TaggedTrans eff trans m a
199199 {-# INLINE state #-}
200200
201201instance
202202 ( HasLens tag payload s
203203 , Handle STATE payload trans
204204 , Monad m, Monad (trans m)
205− ) => MonadState tag s (Handler (TAGGED STATE tag ': effs) trans m)
205+ ) => MonadState tag s (TaggedTrans (TAGGED STATE tag ': effs) trans m)
206206 where
207207
208208 get =
209209 handling @STATE @payload @trans @m $
210210 (coerce :: forall eff a .
211211 trans m a ->
212− Handler eff trans m a)
212+ TaggedTrans eff trans m a)
213213 (T.gets (view (lensOf @tag @payload @s)))
214214 {-# INLINE get #-}
215215
@@ -217,7 +217,7 @@ instance
217217 handling @STATE @payload @trans @m $
218218 (coerce :: forall eff a .
219219 trans m a ->
220− Handler eff trans m a)
220+ TaggedTrans eff trans m a)
221221 (T.modify (over (lensOf @tag @payload @s) (const s)))
222222 {-# INLINE put #-}
223223
@@ -225,7 +225,7 @@ instance
225225 handling @STATE @payload @trans @m $
226226 (coerce :: forall eff a .
227227 trans m a ->
228− Handler eff trans m a)
228+ TaggedTrans eff trans m a)
229229 (T.state (lensOf @tag @payload @s f))
230230 {-# INLINE state #-}
231231
@@ -241,7 +241,7 @@ type State tag r = StateT tag r Identity
241241--
242242-- The 'return' function leaves the state unchanged, while '>>=' uses
243243-- the final state of the first computation as the initial state of the second.
244−type StateT tag s = Handler (TAGGED STATE tag) (T.Strict.StateT s)
244+type StateT tag s = TaggedTrans (TAGGED STATE tag) (T.Strict.StateT s)
245245
246246-- | Constructor for computations in the state monad transformer.
247247stateT :: forall tag s m a . (s -> m (a, s)) -> StateT tag s m a
@@ -296,7 +296,7 @@ type LazyState tag r = LazyStateT tag r Identity
296296--
297297-- The 'return' function leaves the state unchanged, while '>>=' uses
298298-- the final state of the first computation as the initial state of the second.
299−type LazyStateT tag s = Handler (TAGGED STATE tag) (T.Lazy.StateT s)
299+type LazyStateT tag s = TaggedTrans (TAGGED STATE tag) (T.Lazy.StateT s)
300300
301301-- | Constructor for computations in the state monad transformer.
302302lazyStateT :: forall tag s m a . (s -> m (a, s)) -> LazyStateT tag s m a
@@ -343,7 +343,7 @@ type family STATES (ts :: HList xs) :: [Type] where
343343 STATES 'HNil = '[]
344344 STATES ('HCons t ts) = TAGGED STATE t ': STATES ts
345345
346−type StatesT s = Handler (STATES (Tags s)) (T.Strict.StateT s)
346+type StatesT s = TaggedTrans (STATES (Tags s)) (T.Strict.StateT s)
347347
348348type States s = StatesT s Identity
349349
@@ -444,7 +444,7 @@ modify' = modify @s
444444-- | Encode type-level information for 'zoom'.
445445data ZOOM t z
446446
447−type ZoomT t (z :: Type) = Handler (ZOOM t z) IdentityT
447+type ZoomT t (z :: Type) = TaggedTrans (ZOOM t z) IdentityT
448448
449449newtype ReifiedLens s t a b = Lens (Lens s t a b)
450450
@@ -463,12 +463,12 @@ instance
463463 ( MonadState tag sOuter m
464464 , Reifies z (ReifiedLens' sOuter sInner)
465465 , trans ~ IdentityT
466− ) => MonadState tag sInner (Handler (ZOOM tag z) trans m)
466+ ) => MonadState tag sInner (TaggedTrans (ZOOM tag z) trans m)
467467 where
468468 state =
469469 (coerce :: forall eff r a .
470− (r -> m a) ->
471− (r -> Handler eff trans m a))
470+ (r -> m a) ->
471+ (r -> TaggedTrans eff trans m a))
472472 (state @tag . l)
473473 where
474474 Lens l = reflect (Proxy :: Proxy z)
src/Ether/TagDispatch.hs+11−11
@@ -50,7 +50,7 @@ import Ether.Except
5050import Ether.Reader
5151import Ether.State
5252import Ether.Writer
53−import Ether.Handler
53+import Ether.TaggedTrans
5454
5555import Control.Monad.Trans.Identity
5656import Data.Coerce
@@ -58,7 +58,7 @@ import Data.Coerce
5858-- | Encode type-level information for 'tagAttach'.
5959data TAG_ATTACH t
6060
61−type TagAttachT t = Handler (TAG_ATTACH t) IdentityT
61+type TagAttachT t = TaggedTrans (TAG_ATTACH t) IdentityT
6262
6363-- | Attach a tag to untagged transformers.
6464tagAttach :: forall tag m a . TagAttachT tag m a -> m a
@@ -67,7 +67,7 @@ tagAttach = coerce (runIdentityT @_ @m @a)
6767
6868instance
6969 ( MonadReader tag r m, trans ~ IdentityT
70− ) => Mtl.MonadReader r (Handler (TAG_ATTACH tag) trans m)
70+ ) => Mtl.MonadReader r (TaggedTrans (TAG_ATTACH tag) trans m)
7171 where
7272
7373 ask = ask @tag
@@ -81,7 +81,7 @@ instance
8181
8282instance
8383 ( MonadState tag s m, trans ~ IdentityT
84− ) => Mtl.MonadState s (Handler (TAG_ATTACH tag) trans m)
84+ ) => Mtl.MonadState s (TaggedTrans (TAG_ATTACH tag) trans m)
8585 where
8686
8787 get = get @tag
@@ -95,7 +95,7 @@ instance
9595
9696instance
9797 ( MonadExcept tag e m, trans ~ IdentityT
98− ) => Mtl.MonadError e (Handler (TAG_ATTACH tag) trans m)
98+ ) => Mtl.MonadError e (TaggedTrans (TAG_ATTACH tag) trans m)
9999 where
100100
101101 throwError = throw @tag
@@ -106,7 +106,7 @@ instance
106106
107107instance
108108 ( MonadWriter tag w m, trans ~ IdentityT
109− ) => Mtl.MonadWriter w (Handler (TAG_ATTACH tag) trans m)
109+ ) => Mtl.MonadWriter w (TaggedTrans (TAG_ATTACH tag) trans m)
110110 where
111111
112112 writer = writer @tag
@@ -124,7 +124,7 @@ instance
124124-- | Encode type-level information for 'tagReplace'.
125125data TAG_REPLACE tOld tNew
126126
127−type TagReplaceT tOld tNew = Handler (TAG_REPLACE tOld tNew) IdentityT
127+type TagReplaceT tOld tNew = TaggedTrans (TAG_REPLACE tOld tNew) IdentityT
128128
129129-- | Replace a tag with another tag.
130130tagReplace :: forall tOld tNew m a . TagReplaceT tOld tNew m a -> m a
@@ -133,7 +133,7 @@ tagReplace = coerce (runIdentityT @_ @m @a)
133133
134134instance
135135 ( MonadReader tNew r m, trans ~ IdentityT
136− ) => MonadReader tOld r (Handler (TAG_REPLACE tOld tNew) trans m)
136+ ) => MonadReader tOld r (TaggedTrans (TAG_REPLACE tOld tNew) trans m)
137137 where
138138
139139 ask = ask @tNew
@@ -147,7 +147,7 @@ instance
147147
148148instance
149149 ( MonadState tNew s m, trans ~ IdentityT
150− ) => MonadState tOld s (Handler (TAG_REPLACE tOld tNew) trans m)
150+ ) => MonadState tOld s (TaggedTrans (TAG_REPLACE tOld tNew) trans m)
151151 where
152152
153153 get = get @tNew
@@ -161,7 +161,7 @@ instance
161161
162162instance
163163 ( MonadExcept tNew e m, trans ~ IdentityT
164− ) => MonadExcept tOld e (Handler (TAG_REPLACE tOld tNew) trans m)
164+ ) => MonadExcept tOld e (TaggedTrans (TAG_REPLACE tOld tNew) trans m)
165165 where
166166
167167 throw = throw @tNew
@@ -172,7 +172,7 @@ instance
172172
173173instance
174174 ( MonadWriter tNew w m, trans ~ IdentityT
175− ) => MonadWriter tOld w (Handler (TAG_REPLACE tOld tNew) trans m)
175+ ) => MonadWriter tOld w (TaggedTrans (TAG_REPLACE tOld tNew) trans m)
176176 where
177177
178178 writer = writer @tNew
src/Ether/Handler.hs → src/Ether/TaggedTrans.hsrenamed+47−42
@@ -1,5 +1,5 @@
1−module Ether.Handler
2− ( Handler(..)
1+module Ether.TaggedTrans
2+ ( TaggedTrans(..)
33 ) where
44
55import Control.Applicative
@@ -29,109 +29,114 @@ import qualified Control.Monad.Error.Class as Mtl
2929import GHC.Generics (Generic)
3030import Data.Coerce (coerce)
3131
32−newtype Handler eff trans m a = Handler (trans m a)
32+newtype TaggedTrans tag trans m a = TaggedTrans (trans m a)
3333 deriving
3434 ( Generic
3535 , Functor, Applicative, Alternative, Monad, MonadPlus
3636 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad
3737 , MonadThrow, MonadCatch, MonadMask )
3838
39−type Pack eff trans m a = trans m a -> Handler eff trans m a
39+type Pack tag trans m a = trans m a -> TaggedTrans tag trans m a
4040
41−type Unpack eff trans m a = Handler eff trans m a -> trans m a
41+type Unpack tag trans m a = TaggedTrans tag trans m a -> trans m a
4242
4343instance
4444 ( MB.MonadBase b (trans m)
45− ) => MB.MonadBase b (Handler eff trans m)
45+ ) => MB.MonadBase b (TaggedTrans tag trans m)
4646 where
4747 liftBase =
4848 (coerce :: forall a .
4949 (b a -> trans m a) ->
50− (b a -> Handler eff trans m a))
50+ (b a -> TaggedTrans tag trans m a))
5151 MB.liftBase
52+ {-# INLINE liftBase #-}
5253
5354instance
5455 ( MC.MonadTransControl trans
55− ) => MC.MonadTransControl (Handler eff trans)
56+ ) => MC.MonadTransControl (TaggedTrans tag trans)
5657 where
57− type StT (Handler eff trans) a = MC.StT trans a
58+ type StT (TaggedTrans tag trans) a = MC.StT trans a
59+
5860 liftWith = MC.defaultLiftWith
59− (coerce :: Pack eff trans m a)
60− (coerce :: Unpack eff trans m a)
61+ (coerce :: Pack tag trans m a)
62+ (coerce :: Unpack tag trans m a)
63+ {-# INLINE liftWith #-}
64+
6165 restoreT = MC.defaultRestoreT
62− (coerce :: Pack eff trans m a)
66+ (coerce :: Pack tag trans m a)
67+ {-# INLINE restoreT #-}
6368
6469type LiftBaseWith b m a = (MC.RunInBase m b -> b a) -> m a
6570
6671newtype LiftBaseWith' b m a = LBW { unLBW :: LiftBaseWith b m a }
6772
6873coerceLiftBaseWith ::
69− LiftBaseWith b (trans m) a ->
70− LiftBaseWith b (Handler eff trans m) a
74+ LiftBaseWith b (trans m) a ->
75+ LiftBaseWith b (TaggedTrans tag trans m) a
7176coerceLiftBaseWith lbw =
7277 unLBW (coerce (LBW lbw))
7378{-# INLINE coerceLiftBaseWith #-}
7479
7580instance
7681 ( MC.MonadBaseControl b (trans m)
77− ) => MC.MonadBaseControl b (Handler eff trans m)
82+ ) => MC.MonadBaseControl b (TaggedTrans tag trans m)
7883 where
79− type StM (Handler eff trans m) a = MC.StM (trans m) a
84+ type StM (TaggedTrans tag trans m) a = MC.StM (trans m) a
8085
8186 liftBaseWith = coerceLiftBaseWith MC.liftBaseWith
8287 {-# INLINE liftBaseWith #-}
8388
8489 restoreM =
8590 (coerce :: forall a .
86− (MC.StM (trans m) a -> trans m a) ->
87− (MC.StM (trans m) a -> Handler eff trans m a))
91+ (MC.StM (trans m) a -> trans m a) ->
92+ (MC.StM (trans m) a -> TaggedTrans tag trans m a))
8893 MC.restoreM
8994 {-# INLINE restoreM #-}
9095
91−type instance Lift.StT (Handler eff trans) a = Lift.StT trans a
96+type instance Lift.StT (TaggedTrans tag trans) a = Lift.StT trans a
9297
93−instance Lift.LiftLocal trans => Lift.LiftLocal (Handler eff trans) where
98+instance Lift.LiftLocal trans => Lift.LiftLocal (TaggedTrans tag trans) where
9499 liftLocal =
95100 Lift.defaultLiftLocal
96− (coerce :: Pack eff trans m a)
97− (coerce :: Unpack eff trans m a)
101+ (coerce :: Pack tag trans m a)
102+ (coerce :: Unpack tag trans m a)
98103
99−instance Lift.LiftCatch trans => Lift.LiftCatch (Handler eff trans) where
104+instance Lift.LiftCatch trans => Lift.LiftCatch (TaggedTrans tag trans) where
100105 liftCatch =
101106 Lift.defaultLiftCatch
102− (coerce :: Pack eff trans m a)
103− (coerce :: Unpack eff trans m a)
107+ (coerce :: Pack tag trans m a)
108+ (coerce :: Unpack tag trans m a)
104109
105−instance Lift.LiftListen trans => Lift.LiftListen (Handler eff trans) where
110+instance Lift.LiftListen trans => Lift.LiftListen (TaggedTrans tag trans) where
106111 liftListen =
107112 Lift.defaultLiftListen
108− (coerce :: Pack eff trans m a)
109− (coerce :: Unpack eff trans m a)
113+ (coerce :: Pack tag trans m a)
114+ (coerce :: Unpack tag trans m a)
110115
111−instance Lift.LiftPass trans => Lift.LiftPass (Handler eff trans) where
116+instance Lift.LiftPass trans => Lift.LiftPass (TaggedTrans tag trans) where
112117 liftPass =
113118 Lift.defaultLiftPass
114− (coerce :: Pack eff trans m a)
115− (coerce :: Unpack eff trans m a)
119+ (coerce :: Pack tag trans m a)
120+ (coerce :: Unpack tag trans m a)
116121
117−instance Lift.LiftCallCC trans => Lift.LiftCallCC (Handler eff trans) where
122+instance Lift.LiftCallCC trans => Lift.LiftCallCC (TaggedTrans tag trans) where
118123 liftCallCC =
119124 Lift.defaultLiftCallCC
120− (coerce :: Pack eff trans m a)
121− (coerce :: Unpack eff trans m a)
125+ (coerce :: Pack tag trans m a)
126+ (coerce :: Unpack tag trans m a)
122127 liftCallCC' =
123128 Lift.defaultLiftCallCC'
124− (coerce :: Pack eff trans m a)
125− (coerce :: Unpack eff trans m a)
129+ (coerce :: Pack tag trans m a)
130+ (coerce :: Unpack tag trans m a)
126131
127132
128−-- Instances for mtl Mtles
133+-- Instances for mtl classes
129134
130135instance {-# OVERLAPPABLE #-}
131136 ( Mtl.MonadCont m
132137 , Lift.LiftCallCC trans
133138 , Monad (trans m)
134− ) => Mtl.MonadCont (Handler eff trans m)
139+ ) => Mtl.MonadCont (TaggedTrans tag trans m)
135140 where
136141 callCC = Lift.liftCallCC' Mtl.callCC
137142
@@ -139,7 +144,7 @@ instance {-# OVERLAPPABLE #-}
139144 ( Mtl.MonadReader r m
140145 , Lift.LiftLocal trans
141146 , Monad (trans m)
142− ) => Mtl.MonadReader r (Handler eff trans m)
147+ ) => Mtl.MonadReader r (TaggedTrans tag trans m)
143148 where
144149 ask = lift Mtl.ask
145150 local = Lift.liftLocal Mtl.ask Mtl.local
@@ -149,7 +154,7 @@ instance {-# OVERLAPPABLE #-}
149154 ( Mtl.MonadState s m
150155 , MonadTrans trans
151156 , Monad (trans m)
152− ) => Mtl.MonadState s (Handler eff trans m)
157+ ) => Mtl.MonadState s (TaggedTrans tag trans m)
153158 where
154159 get = lift Mtl.get
155160 put = lift . Mtl.put
@@ -160,7 +165,7 @@ instance {-# OVERLAPPABLE #-}
160165 , Lift.LiftListen trans
161166 , Lift.LiftPass trans
162167 , Monad (trans m)
163− ) => Mtl.MonadWriter w (Handler eff trans m)
168+ ) => Mtl.MonadWriter w (TaggedTrans tag trans m)
164169 where
165170 writer = lift . Mtl.writer
166171 tell = lift . Mtl.tell
@@ -171,7 +176,7 @@ instance {-# OVERLAPPABLE #-}
171176 ( Mtl.MonadError e m
172177 , Lift.LiftCatch trans
173178 , Monad (trans m)
174− ) => Mtl.MonadError e (Handler eff trans m)
179+ ) => Mtl.MonadError e (TaggedTrans tag trans m)
175180 where
176181 throwError = lift . Mtl.throwError
177182 catchError = Lift.liftCatch Mtl.catchError
src/Ether/Writer.hs+6−6
@@ -46,7 +46,7 @@ import qualified Control.Monad.Writer as T
4646import Data.Coerce
4747import Data.Functor.Identity
4848
49−import Ether.Handler
49+import Ether.TaggedTrans
5050import Ether.Internal
5151
5252class (Monoid w, Monad m) => MonadWriter tag w m | m tag -> w where
@@ -117,7 +117,7 @@ type Writer tag w = WriterT tag w Identity
117117--
118118-- The 'return' function produces the output 'mempty', while '>>=' combines
119119-- the outputs of the subcomputations using 'mappend'.
120−type WriterT tag w = Handler (TAGGED WRITER tag) (T.WriterT w)
120+type WriterT tag w = TaggedTrans (TAGGED WRITER tag) (T.WriterT w)
121121
122122-- | Constructor for computations in the writer monad transformer.
123123writerT :: forall tag w m a . m (a, w) -> WriterT tag w m a
@@ -154,13 +154,13 @@ instance Monoid w => Handle WRITER w (T.WriterT w) where
154154instance
155155 ( Handle WRITER w trans
156156 , Monad m, Monad (trans m)
157− ) => MonadWriter tag w (Handler (TAGGED WRITER tag) trans m)
157+ ) => MonadWriter tag w (TaggedTrans (TAGGED WRITER tag) trans m)
158158 where
159159
160160 writer =
161161 handling @WRITER @w @trans @m $
162162 coerce (T.writer @w @(trans m) @a) ::
163− forall eff a . (a, w) -> Handler eff trans m a
163+ forall eff a . (a, w) -> TaggedTrans eff trans m a
164164 {-# INLINE writer #-}
165165
166166 tell =
@@ -171,13 +171,13 @@ instance
171171 listen =
172172 handling @WRITER @w @trans @m $
173173 coerce (T.listen @w @(trans m) @a) ::
174− forall eff a . Listen w (Handler eff trans m) a
174+ forall eff a . Listen w (TaggedTrans eff trans m) a
175175 {-# INLINE listen #-}
176176
177177 pass =
178178 handling @WRITER @w @trans @m $
179179 coerce (T.pass @w @(trans m) @a) ::
180− forall eff a . Pass w (Handler eff trans m) a
180+ forall eff a . Pass w (TaggedTrans eff trans m) a
181181 {-# INLINE pass #-}
182182
183183type Writer' w = Writer w w