git.iko.soy/typeable/ether
on master help sign in
Rename Handler back to TaggedTrans
d24e51aVladislav Zavialov
CHANGELOG.md+1−1
compare with master
unifiedsplit
@@ -5,7 +5,7 @@
5* Use the `TypeApplications` extension to get rid of `Proxy`.
5* Use the `TypeApplications` extension to get rid of `Proxy`.
6* Remove `Control.Ether.TH`.
6* Remove `Control.Ether.TH`.
7* Remove `Control.Ether.Abbr`.
7* Remove `Control.Ether.Abbr`.
8−* Unify `Dispatch` and `TaggedTrans` as `Handler`.
8+* Unify `Dispatch` and `TaggedTrans`.
9* Better `MonadBase` and `MonadBaseControl` instances.
9* Better `MonadBase` and `MonadBaseControl` instances.
10* Add flattening for `ReaderT` and `StateT`.
10* Add flattening for `ReaderT` and `StateT`.
11* Add zooming for `MonadState`.
11* Add zooming for `MonadState`.
ether.cabal+1−1
@@ -32,7 +32,7 @@ library
32 Ether.State
32 Ether.State
33 Ether.Writer
33 Ether.Writer
34 Ether.Except
34 Ether.Except
35− Ether.Handler
35+ Ether.TaggedTrans
36 Ether.TagDispatch
36 Ether.TagDispatch
37 Ether.Internal
37 Ether.Internal
38
38
src/Ether.hs+2−2
@@ -9,7 +9,7 @@ module Ether
9 , module Ether.State
9 , module Ether.State
10 , module Ether.Except
10 , module Ether.Except
11 , module Ether.TagDispatch
11 , module Ether.TagDispatch
12− , module Ether.Handler
12+ , module Ether.TaggedTrans
13 ) where
13 ) where
14
14
15import Control.Monad
15import Control.Monad
@@ -22,4 +22,4 @@ import Ether.Writer
22import Ether.State
22import Ether.State
23import Ether.Except
23import Ether.Except
24import Ether.TagDispatch
24import 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
33import Data.Coerce
33import Data.Coerce
34import Data.Functor.Identity
34import Data.Functor.Identity
35
35
36−import Ether.Handler
36+import Ether.TaggedTrans
37import Ether.Internal
37import Ether.Internal
38
38
39class Monad m => MonadExcept tag e m | m tag -> e where
39class 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
41 -- | Is used within a monadic computation to begin exception processing.
41 -- | Is used within a monadic computation to begin exception processing.
42 throw :: e -> m a
42 throw :: e -> m a
43
43
44− -- | A handler function to handle previous exceptions and return to
44+ -- | A TaggedTrans function to handle previous exceptions and return to
45 -- normal execution.
45 -- normal execution.
46 catch :: m a -> (e -> m a) -> m a
46 catch :: m a -> (e -> m a) -> m a
47
47
@@ -72,7 +72,7 @@ type Except tag e = ExceptT tag e Identity
72--
72--
73-- The 'return' function returns a normal value, while '>>=' exits on
73-- The 'return' function returns a normal value, while '>>=' exits on
74-- the first exception.
74-- 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)
76
76
77-- | Runs an 'Except' and returns either an exception or a normal value.
77-- | Runs an 'Except' and returns either an exception or a normal value.
78runExcept :: forall tag e a . Except tag e a -> Either e a
78runExcept :: forall tag e a . Except tag e a -> Either e a
@@ -100,18 +100,18 @@ instance Handle EXCEPT e (T.ExceptT e) where
100instance
100instance
101 ( Handle EXCEPT e trans
101 ( Handle EXCEPT e trans
102 , Monad m, Monad (trans m)
102 , 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)
104 where
104 where
105 throw =
105 throw =
106 handling @EXCEPT @e @trans @m $
106 handling @EXCEPT @e @trans @m $
107 coerce (T.throwError @e @(trans m) @a) ::
107 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
109 {-# INLINE throw #-}
109 {-# INLINE throw #-}
110
110
111 catch =
111 catch =
112 handling @EXCEPT @e @trans @m $
112 handling @EXCEPT @e @trans @m $
113 coerce (T.catchError @e @(trans m) @a) ::
113 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
115 {-# INLINE catch #-}
115 {-# INLINE catch #-}
116
116
117type MonadExcept' e = MonadExcept e e
117type MonadExcept' e = MonadExcept e e
src/Ether/Reader.hs+17−17
@@ -45,7 +45,7 @@ import Data.Coerce
45import Data.Functor.Identity
45import Data.Functor.Identity
46import Data.Kind
46import Data.Kind
47
47
48−import Ether.Handler
48+import Ether.TaggedTrans
49import Ether.Internal
49import Ether.Internal
50
50
51class Monad m => MonadReader tag r m | m tag -> r where
51class Monad m => MonadReader tag r m | m tag -> r where
@@ -89,28 +89,28 @@ instance {-# OVERLAPPABLE #-}
89
89
90instance {-# OVERLAPPABLE #-}
90instance {-# OVERLAPPABLE #-}
91 ( Monad (trans m)
91 ( Monad (trans m)
92− , MonadReader tag r (Handler effs trans m)
92+ , MonadReader tag r (TaggedTrans effs trans m)
93− ) => MonadReader tag r (Handler (eff ': effs) trans (m :: Type -> Type))
93+ ) => MonadReader tag r (TaggedTrans (eff ': effs) trans (m :: Type -> Type))
94 where
94 where
95
95
96 ask =
96 ask =
97 (coerce ::
97 (coerce ::
98− Handler effs trans m r ->
98+ TaggedTrans effs trans m r ->
99− Handler (eff ': effs) trans m r)
99+ TaggedTrans (eff ': effs) trans m r)
100 (ask @tag)
100 (ask @tag)
101 {-# INLINE ask #-}
101 {-# INLINE ask #-}
102
102
103 local =
103 local =
104 (coerce :: forall a .
104 (coerce :: forall a .
105− Lift.Local r (Handler effs trans m) a ->
105+ Lift.Local r (TaggedTrans effs trans m) a ->
106− Lift.Local r (Handler (eff ': effs) trans m) a)
106+ Lift.Local r (TaggedTrans (eff ': effs) trans m) a)
107 (local @tag)
107 (local @tag)
108 {-# INLINE local #-}
108 {-# INLINE local #-}
109
109
110 reader =
110 reader =
111 (coerce :: forall a .
111 (coerce :: forall a .
112− ((r -> a) -> Handler effs trans m a) ->
112+ ((r -> a) -> TaggedTrans effs trans m a) ->
113− ((r -> a) -> Handler (eff ': effs) trans m a))
113+ ((r -> a) -> TaggedTrans (eff ': effs) trans m a))
114 (reader @tag)
114 (reader @tag)
115 {-# INLINE reader #-}
115 {-# INLINE reader #-}
116
116
@@ -140,7 +140,7 @@ type Reader tag r = ReaderT tag r Identity
140--
140--
141-- The 'return' function ignores the environment, while '>>=' passes
141-- The 'return' function ignores the environment, while '>>=' passes
142-- the inherited environment to both subcomputations.
142-- 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)
144
144
145-- | Constructor for computations in the reader monad transformer.
145-- | Constructor for computations in the reader monad transformer.
146readerT :: forall tag r m a . (r -> m a) -> ReaderT tag r m a
146readerT :: 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
170instance
170instance
171 ( Handle READER r trans
171 ( Handle READER r trans
172 , Monad m, Monad (trans m)
172 , 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)
174 where
174 where
175
175
176 ask =
176 ask =
@@ -181,27 +181,27 @@ instance
181 local =
181 local =
182 handling @READER @r @trans @m $
182 handling @READER @r @trans @m $
183 coerce (T.local @r @(trans m) @a) ::
183 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
185 {-# INLINE local #-}
185 {-# INLINE local #-}
186
186
187 reader =
187 reader =
188 handling @READER @r @trans @m $
188 handling @READER @r @trans @m $
189 coerce (T.reader @r @(trans m) @a) ::
189 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
191 {-# INLINE reader #-}
191 {-# INLINE reader #-}
192
192
193instance
193instance
194 ( HasLens tag payload r
194 ( HasLens tag payload r
195 , Handle READER payload trans
195 , Handle READER payload trans
196 , Monad m, Monad (trans m)
196 , 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)
198 where
198 where
199
199
200 ask =
200 ask =
201 handling @READER @payload @trans @m $
201 handling @READER @payload @trans @m $
202 (coerce :: forall eff a .
202 (coerce :: forall eff a .
203 trans m a ->
203 trans m a ->
204− Handler eff trans m a)
204+ TaggedTrans eff trans m a)
205 (T.asks (view (lensOf @tag @payload @r)))
205 (T.asks (view (lensOf @tag @payload @r)))
206 {-# INLINE ask #-}
206 {-# INLINE ask #-}
207
207
@@ -209,7 +209,7 @@ instance
209 handling @READER @payload @trans @m $
209 handling @READER @payload @trans @m $
210 (coerce :: forall eff a .
210 (coerce :: forall eff a .
211 (trans m a -> trans m a) ->
211 (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))
213 (T.local (over (lensOf @tag @payload @r) f))
213 (T.local (over (lensOf @tag @payload @r) f))
214 {-# INLINE local #-}
214 {-# INLINE local #-}
215
215
@@ -217,7 +217,7 @@ type family READERS (ts :: HList xs) :: [Type] where
217 READERS 'HNil = '[]
217 READERS 'HNil = '[]
218 READERS ('HCons t ts) = TAGGED READER t ': READERS ts
218 READERS ('HCons t ts) = TAGGED READER t ': READERS ts
219
219
220−type ReadersT r = Handler (READERS (Tags r)) (T.ReaderT r)
220+type ReadersT r = TaggedTrans (READERS (Tags r)) (T.ReaderT r)
221
221
222type Readers r = ReadersT r Identity
222type Readers r = ReadersT r Identity
223
223
src/Ether/State.hs+22−22
@@ -85,7 +85,7 @@ import Data.Kind
85import Data.Proxy
85import Data.Proxy
86import Data.Reflection
86import Data.Reflection
87
87
88−import Ether.Handler
88+import Ether.TaggedTrans
89import Ether.Internal
89import Ether.Internal
90
90
91class Monad m => MonadState tag s m | m tag -> s where
91class Monad m => MonadState tag s m | m tag -> s where
@@ -126,28 +126,28 @@ instance {-# OVERLAPPABLE #-}
126
126
127instance {-# OVERLAPPABLE #-}
127instance {-# OVERLAPPABLE #-}
128 ( Monad (trans m)
128 ( Monad (trans m)
129− , MonadState tag s (Handler effs trans m)
129+ , MonadState tag s (TaggedTrans effs trans m)
130− ) => MonadState tag s (Handler (eff ': effs) trans (m :: Type -> Type))
130+ ) => MonadState tag s (TaggedTrans (eff ': effs) trans (m :: Type -> Type))
131 where
131 where
132
132
133 get =
133 get =
134 (coerce ::
134 (coerce ::
135− Handler effs trans m s ->
135+ TaggedTrans effs trans m s ->
136− Handler (eff ': effs) trans m s)
136+ TaggedTrans (eff ': effs) trans m s)
137 (get @tag)
137 (get @tag)
138 {-# INLINE get #-}
138 {-# INLINE get #-}
139
139
140 put =
140 put =
141 (coerce ::
141 (coerce ::
142− (s -> Handler effs trans m ()) ->
142+ (s -> TaggedTrans effs trans m ()) ->
143− (s -> Handler (eff ': effs) trans m ()))
143+ (s -> TaggedTrans (eff ': effs) trans m ()))
144 (put @tag)
144 (put @tag)
145 {-# INLINE put #-}
145 {-# INLINE put #-}
146
146
147 state =
147 state =
148 (coerce :: forall a .
148 (coerce :: forall a .
149− ((s -> (a, s)) -> Handler effs trans m a) ->
149+ ((s -> (a, s)) -> TaggedTrans effs trans m a) ->
150− ((s -> (a, s)) -> Handler (eff ': effs) trans m a))
150+ ((s -> (a, s)) -> TaggedTrans (eff ': effs) trans m a))
151 (state @tag)
151 (state @tag)
152 {-# INLINE state #-}
152 {-# INLINE state #-}
153
153
@@ -179,7 +179,7 @@ instance Handle STATE s (T.Lazy.StateT s) where
179instance
179instance
180 ( Handle STATE s trans
180 ( Handle STATE s trans
181 , Monad m, Monad (trans m)
181 , 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)
183 where
183 where
184
184
185 get =
185 get =
@@ -195,21 +195,21 @@ instance
195 state =
195 state =
196 handling @STATE @s @trans @m $
196 handling @STATE @s @trans @m $
197 coerce (T.state @s @(trans m) @a) ::
197 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
199 {-# INLINE state #-}
199 {-# INLINE state #-}
200
200
201instance
201instance
202 ( HasLens tag payload s
202 ( HasLens tag payload s
203 , Handle STATE payload trans
203 , Handle STATE payload trans
204 , Monad m, Monad (trans m)
204 , 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)
206 where
206 where
207
207
208 get =
208 get =
209 handling @STATE @payload @trans @m $
209 handling @STATE @payload @trans @m $
210 (coerce :: forall eff a .
210 (coerce :: forall eff a .
211 trans m a ->
211 trans m a ->
212− Handler eff trans m a)
212+ TaggedTrans eff trans m a)
213 (T.gets (view (lensOf @tag @payload @s)))
213 (T.gets (view (lensOf @tag @payload @s)))
214 {-# INLINE get #-}
214 {-# INLINE get #-}
215
215
@@ -217,7 +217,7 @@ instance
217 handling @STATE @payload @trans @m $
217 handling @STATE @payload @trans @m $
218 (coerce :: forall eff a .
218 (coerce :: forall eff a .
219 trans m a ->
219 trans m a ->
220− Handler eff trans m a)
220+ TaggedTrans eff trans m a)
221 (T.modify (over (lensOf @tag @payload @s) (const s)))
221 (T.modify (over (lensOf @tag @payload @s) (const s)))
222 {-# INLINE put #-}
222 {-# INLINE put #-}
223
223
@@ -225,7 +225,7 @@ instance
225 handling @STATE @payload @trans @m $
225 handling @STATE @payload @trans @m $
226 (coerce :: forall eff a .
226 (coerce :: forall eff a .
227 trans m a ->
227 trans m a ->
228− Handler eff trans m a)
228+ TaggedTrans eff trans m a)
229 (T.state (lensOf @tag @payload @s f))
229 (T.state (lensOf @tag @payload @s f))
230 {-# INLINE state #-}
230 {-# INLINE state #-}
231
231
@@ -241,7 +241,7 @@ type State tag r = StateT tag r Identity
241--
241--
242-- The 'return' function leaves the state unchanged, while '>>=' uses
242-- The 'return' function leaves the state unchanged, while '>>=' uses
243-- the final state of the first computation as the initial state of the second.
243-- 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)
245
245
246-- | Constructor for computations in the state monad transformer.
246-- | Constructor for computations in the state monad transformer.
247stateT :: forall tag s m a . (s -> m (a, s)) -> StateT tag s m a
247stateT :: 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
296--
296--
297-- The 'return' function leaves the state unchanged, while '>>=' uses
297-- The 'return' function leaves the state unchanged, while '>>=' uses
298-- the final state of the first computation as the initial state of the second.
298-- 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)
300
300
301-- | Constructor for computations in the state monad transformer.
301-- | Constructor for computations in the state monad transformer.
302lazyStateT :: forall tag s m a . (s -> m (a, s)) -> LazyStateT tag s m a
302lazyStateT :: 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
343 STATES 'HNil = '[]
343 STATES 'HNil = '[]
344 STATES ('HCons t ts) = TAGGED STATE t ': STATES ts
344 STATES ('HCons t ts) = TAGGED STATE t ': STATES ts
345
345
346−type StatesT s = Handler (STATES (Tags s)) (T.Strict.StateT s)
346+type StatesT s = TaggedTrans (STATES (Tags s)) (T.Strict.StateT s)
347
347
348type States s = StatesT s Identity
348type States s = StatesT s Identity
349
349
@@ -444,7 +444,7 @@ modify' = modify @s
444-- | Encode type-level information for 'zoom'.
444-- | Encode type-level information for 'zoom'.
445data ZOOM t z
445data ZOOM t z
446
446
447−type ZoomT t (z :: Type) = Handler (ZOOM t z) IdentityT
447+type ZoomT t (z :: Type) = TaggedTrans (ZOOM t z) IdentityT
448
448
449newtype ReifiedLens s t a b = Lens (Lens s t a b)
449newtype ReifiedLens s t a b = Lens (Lens s t a b)
450
450
@@ -463,12 +463,12 @@ instance
463 ( MonadState tag sOuter m
463 ( MonadState tag sOuter m
464 , Reifies z (ReifiedLens' sOuter sInner)
464 , Reifies z (ReifiedLens' sOuter sInner)
465 , trans ~ IdentityT
465 , trans ~ IdentityT
466− ) => MonadState tag sInner (Handler (ZOOM tag z) trans m)
466+ ) => MonadState tag sInner (TaggedTrans (ZOOM tag z) trans m)
467 where
467 where
468 state =
468 state =
469 (coerce :: forall eff r a .
469 (coerce :: forall eff r a .
470− (r -> m a) ->
470+ (r -> m a) ->
471− (r -> Handler eff trans m a))
471+ (r -> TaggedTrans eff trans m a))
472 (state @tag . l)
472 (state @tag . l)
473 where
473 where
474 Lens l = reflect (Proxy :: Proxy z)
474 Lens l = reflect (Proxy :: Proxy z)
src/Ether/TagDispatch.hs+11−11
@@ -50,7 +50,7 @@ import Ether.Except
50import Ether.Reader
50import Ether.Reader
51import Ether.State
51import Ether.State
52import Ether.Writer
52import Ether.Writer
53−import Ether.Handler
53+import Ether.TaggedTrans
54
54
55import Control.Monad.Trans.Identity
55import Control.Monad.Trans.Identity
56import Data.Coerce
56import Data.Coerce
@@ -58,7 +58,7 @@ import Data.Coerce
58-- | Encode type-level information for 'tagAttach'.
58-- | Encode type-level information for 'tagAttach'.
59data TAG_ATTACH t
59data TAG_ATTACH t
60
60
61−type TagAttachT t = Handler (TAG_ATTACH t) IdentityT
61+type TagAttachT t = TaggedTrans (TAG_ATTACH t) IdentityT
62
62
63-- | Attach a tag to untagged transformers.
63-- | Attach a tag to untagged transformers.
64tagAttach :: forall tag m a . TagAttachT tag m a -> m a
64tagAttach :: forall tag m a . TagAttachT tag m a -> m a
@@ -67,7 +67,7 @@ tagAttach = coerce (runIdentityT @_ @m @a)
67
67
68instance
68instance
69 ( MonadReader tag r m, trans ~ IdentityT
69 ( 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)
71 where
71 where
72
72
73 ask = ask @tag
73 ask = ask @tag
@@ -81,7 +81,7 @@ instance
81
81
82instance
82instance
83 ( MonadState tag s m, trans ~ IdentityT
83 ( 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)
85 where
85 where
86
86
87 get = get @tag
87 get = get @tag
@@ -95,7 +95,7 @@ instance
95
95
96instance
96instance
97 ( MonadExcept tag e m, trans ~ IdentityT
97 ( 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)
99 where
99 where
100
100
101 throwError = throw @tag
101 throwError = throw @tag
@@ -106,7 +106,7 @@ instance
106
106
107instance
107instance
108 ( MonadWriter tag w m, trans ~ IdentityT
108 ( 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)
110 where
110 where
111
111
112 writer = writer @tag
112 writer = writer @tag
@@ -124,7 +124,7 @@ instance
124-- | Encode type-level information for 'tagReplace'.
124-- | Encode type-level information for 'tagReplace'.
125data TAG_REPLACE tOld tNew
125data TAG_REPLACE tOld tNew
126
126
127−type TagReplaceT tOld tNew = Handler (TAG_REPLACE tOld tNew) IdentityT
127+type TagReplaceT tOld tNew = TaggedTrans (TAG_REPLACE tOld tNew) IdentityT
128
128
129-- | Replace a tag with another tag.
129-- | Replace a tag with another tag.
130tagReplace :: forall tOld tNew m a . TagReplaceT tOld tNew m a -> m a
130tagReplace :: forall tOld tNew m a . TagReplaceT tOld tNew m a -> m a
@@ -133,7 +133,7 @@ tagReplace = coerce (runIdentityT @_ @m @a)
133
133
134instance
134instance
135 ( MonadReader tNew r m, trans ~ IdentityT
135 ( 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)
137 where
137 where
138
138
139 ask = ask @tNew
139 ask = ask @tNew
@@ -147,7 +147,7 @@ instance
147
147
148instance
148instance
149 ( MonadState tNew s m, trans ~ IdentityT
149 ( 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)
151 where
151 where
152
152
153 get = get @tNew
153 get = get @tNew
@@ -161,7 +161,7 @@ instance
161
161
162instance
162instance
163 ( MonadExcept tNew e m, trans ~ IdentityT
163 ( 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)
165 where
165 where
166
166
167 throw = throw @tNew
167 throw = throw @tNew
@@ -172,7 +172,7 @@ instance
172
172
173instance
173instance
174 ( MonadWriter tNew w m, trans ~ IdentityT
174 ( 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)
176 where
176 where
177
177
178 writer = writer @tNew
178 writer = writer @tNew
src/Ether/Handler.hs → src/Ether/TaggedTrans.hsrenamed+47−42
@@ -1,5 +1,5 @@
1−module Ether.Handler
1+module Ether.TaggedTrans
2− ( Handler(..)
2+ ( TaggedTrans(..)
3 ) where
3 ) where
4
4
5import Control.Applicative
5import Control.Applicative
@@ -29,109 +29,114 @@ import qualified Control.Monad.Error.Class as Mtl
29import GHC.Generics (Generic)
29import GHC.Generics (Generic)
30import Data.Coerce (coerce)
30import Data.Coerce (coerce)
31
31
32−newtype Handler eff trans m a = Handler (trans m a)
32+newtype TaggedTrans tag trans m a = TaggedTrans (trans m a)
33 deriving
33 deriving
34 ( Generic
34 ( Generic
35 , Functor, Applicative, Alternative, Monad, MonadPlus
35 , Functor, Applicative, Alternative, Monad, MonadPlus
36 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad
36 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad
37 , MonadThrow, MonadCatch, MonadMask )
37 , MonadThrow, MonadCatch, MonadMask )
38
38
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
40
40
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
42
42
43instance
43instance
44 ( MB.MonadBase b (trans m)
44 ( MB.MonadBase b (trans m)
45− ) => MB.MonadBase b (Handler eff trans m)
45+ ) => MB.MonadBase b (TaggedTrans tag trans m)
46 where
46 where
47 liftBase =
47 liftBase =
48 (coerce :: forall a .
48 (coerce :: forall a .
49 (b a -> trans m a) ->
49 (b a -> trans m a) ->
50− (b a -> Handler eff trans m a))
50+ (b a -> TaggedTrans tag trans m a))
51 MB.liftBase
51 MB.liftBase
52+ {-# INLINE liftBase #-}
52
53
53instance
54instance
54 ( MC.MonadTransControl trans
55 ( MC.MonadTransControl trans
55− ) => MC.MonadTransControl (Handler eff trans)
56+ ) => MC.MonadTransControl (TaggedTrans tag trans)
56 where
57 where
57− type StT (Handler eff trans) a = MC.StT trans a
58+ type StT (TaggedTrans tag trans) a = MC.StT trans a
59+
58 liftWith = MC.defaultLiftWith
60 liftWith = MC.defaultLiftWith
59− (coerce :: Pack eff trans m a)
61+ (coerce :: Pack tag trans m a)
60− (coerce :: Unpack eff trans m a)
62+ (coerce :: Unpack tag trans m a)
63+ {-# INLINE liftWith #-}
64+
61 restoreT = MC.defaultRestoreT
65 restoreT = MC.defaultRestoreT
62− (coerce :: Pack eff trans m a)
66+ (coerce :: Pack tag trans m a)
67+ {-# INLINE restoreT #-}
63
68
64type LiftBaseWith b m a = (MC.RunInBase m b -> b a) -> m a
69type LiftBaseWith b m a = (MC.RunInBase m b -> b a) -> m a
65
70
66newtype LiftBaseWith' b m a = LBW { unLBW :: LiftBaseWith b m a }
71newtype LiftBaseWith' b m a = LBW { unLBW :: LiftBaseWith b m a }
67
72
68coerceLiftBaseWith ::
73coerceLiftBaseWith ::
69− LiftBaseWith b (trans m) a ->
74+ LiftBaseWith b (trans m) a ->
70− LiftBaseWith b (Handler eff trans m) a
75+ LiftBaseWith b (TaggedTrans tag trans m) a
71coerceLiftBaseWith lbw =
76coerceLiftBaseWith lbw =
72 unLBW (coerce (LBW lbw))
77 unLBW (coerce (LBW lbw))
73{-# INLINE coerceLiftBaseWith #-}
78{-# INLINE coerceLiftBaseWith #-}
74
79
75instance
80instance
76 ( MC.MonadBaseControl b (trans m)
81 ( MC.MonadBaseControl b (trans m)
77− ) => MC.MonadBaseControl b (Handler eff trans m)
82+ ) => MC.MonadBaseControl b (TaggedTrans tag trans m)
78 where
83 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
80
85
81 liftBaseWith = coerceLiftBaseWith MC.liftBaseWith
86 liftBaseWith = coerceLiftBaseWith MC.liftBaseWith
82 {-# INLINE liftBaseWith #-}
87 {-# INLINE liftBaseWith #-}
83
88
84 restoreM =
89 restoreM =
85 (coerce :: forall a .
90 (coerce :: forall a .
86− (MC.StM (trans m) a -> trans m a) ->
91+ (MC.StM (trans m) a -> trans m a) ->
87− (MC.StM (trans m) a -> Handler eff trans m a))
92+ (MC.StM (trans m) a -> TaggedTrans tag trans m a))
88 MC.restoreM
93 MC.restoreM
89 {-# INLINE restoreM #-}
94 {-# INLINE restoreM #-}
90
95
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
92
97
93−instance Lift.LiftLocal trans => Lift.LiftLocal (Handler eff trans) where
98+instance Lift.LiftLocal trans => Lift.LiftLocal (TaggedTrans tag trans) where
94 liftLocal =
99 liftLocal =
95 Lift.defaultLiftLocal
100 Lift.defaultLiftLocal
96− (coerce :: Pack eff trans m a)
101+ (coerce :: Pack tag trans m a)
97− (coerce :: Unpack eff trans m a)
102+ (coerce :: Unpack tag trans m a)
98
103
99−instance Lift.LiftCatch trans => Lift.LiftCatch (Handler eff trans) where
104+instance Lift.LiftCatch trans => Lift.LiftCatch (TaggedTrans tag trans) where
100 liftCatch =
105 liftCatch =
101 Lift.defaultLiftCatch
106 Lift.defaultLiftCatch
102− (coerce :: Pack eff trans m a)
107+ (coerce :: Pack tag trans m a)
103− (coerce :: Unpack eff trans m a)
108+ (coerce :: Unpack tag trans m a)
104
109
105−instance Lift.LiftListen trans => Lift.LiftListen (Handler eff trans) where
110+instance Lift.LiftListen trans => Lift.LiftListen (TaggedTrans tag trans) where
106 liftListen =
111 liftListen =
107 Lift.defaultLiftListen
112 Lift.defaultLiftListen
108− (coerce :: Pack eff trans m a)
113+ (coerce :: Pack tag trans m a)
109− (coerce :: Unpack eff trans m a)
114+ (coerce :: Unpack tag trans m a)
110
115
111−instance Lift.LiftPass trans => Lift.LiftPass (Handler eff trans) where
116+instance Lift.LiftPass trans => Lift.LiftPass (TaggedTrans tag trans) where
112 liftPass =
117 liftPass =
113 Lift.defaultLiftPass
118 Lift.defaultLiftPass
114− (coerce :: Pack eff trans m a)
119+ (coerce :: Pack tag trans m a)
115− (coerce :: Unpack eff trans m a)
120+ (coerce :: Unpack tag trans m a)
116
121
117−instance Lift.LiftCallCC trans => Lift.LiftCallCC (Handler eff trans) where
122+instance Lift.LiftCallCC trans => Lift.LiftCallCC (TaggedTrans tag trans) where
118 liftCallCC =
123 liftCallCC =
119 Lift.defaultLiftCallCC
124 Lift.defaultLiftCallCC
120− (coerce :: Pack eff trans m a)
125+ (coerce :: Pack tag trans m a)
121− (coerce :: Unpack eff trans m a)
126+ (coerce :: Unpack tag trans m a)
122 liftCallCC' =
127 liftCallCC' =
123 Lift.defaultLiftCallCC'
128 Lift.defaultLiftCallCC'
124− (coerce :: Pack eff trans m a)
129+ (coerce :: Pack tag trans m a)
125− (coerce :: Unpack eff trans m a)
130+ (coerce :: Unpack tag trans m a)
126
131
127
132
128−-- Instances for mtl Mtles
133+-- Instances for mtl classes
129
134
130instance {-# OVERLAPPABLE #-}
135instance {-# OVERLAPPABLE #-}
131 ( Mtl.MonadCont m
136 ( Mtl.MonadCont m
132 , Lift.LiftCallCC trans
137 , Lift.LiftCallCC trans
133 , Monad (trans m)
138 , Monad (trans m)
134− ) => Mtl.MonadCont (Handler eff trans m)
139+ ) => Mtl.MonadCont (TaggedTrans tag trans m)
135 where
140 where
136 callCC = Lift.liftCallCC' Mtl.callCC
141 callCC = Lift.liftCallCC' Mtl.callCC
137
142
@@ -139,7 +144,7 @@ instance {-# OVERLAPPABLE #-}
139 ( Mtl.MonadReader r m
144 ( Mtl.MonadReader r m
140 , Lift.LiftLocal trans
145 , Lift.LiftLocal trans
141 , Monad (trans m)
146 , Monad (trans m)
142− ) => Mtl.MonadReader r (Handler eff trans m)
147+ ) => Mtl.MonadReader r (TaggedTrans tag trans m)
143 where
148 where
144 ask = lift Mtl.ask
149 ask = lift Mtl.ask
145 local = Lift.liftLocal Mtl.ask Mtl.local
150 local = Lift.liftLocal Mtl.ask Mtl.local
@@ -149,7 +154,7 @@ instance {-# OVERLAPPABLE #-}
149 ( Mtl.MonadState s m
154 ( Mtl.MonadState s m
150 , MonadTrans trans
155 , MonadTrans trans
151 , Monad (trans m)
156 , Monad (trans m)
152− ) => Mtl.MonadState s (Handler eff trans m)
157+ ) => Mtl.MonadState s (TaggedTrans tag trans m)
153 where
158 where
154 get = lift Mtl.get
159 get = lift Mtl.get
155 put = lift . Mtl.put
160 put = lift . Mtl.put
@@ -160,7 +165,7 @@ instance {-# OVERLAPPABLE #-}
160 , Lift.LiftListen trans
165 , Lift.LiftListen trans
161 , Lift.LiftPass trans
166 , Lift.LiftPass trans
162 , Monad (trans m)
167 , Monad (trans m)
163− ) => Mtl.MonadWriter w (Handler eff trans m)
168+ ) => Mtl.MonadWriter w (TaggedTrans tag trans m)
164 where
169 where
165 writer = lift . Mtl.writer
170 writer = lift . Mtl.writer
166 tell = lift . Mtl.tell
171 tell = lift . Mtl.tell
@@ -171,7 +176,7 @@ instance {-# OVERLAPPABLE #-}
171 ( Mtl.MonadError e m
176 ( Mtl.MonadError e m
172 , Lift.LiftCatch trans
177 , Lift.LiftCatch trans
173 , Monad (trans m)
178 , Monad (trans m)
174− ) => Mtl.MonadError e (Handler eff trans m)
179+ ) => Mtl.MonadError e (TaggedTrans tag trans m)
175 where
180 where
176 throwError = lift . Mtl.throwError
181 throwError = lift . Mtl.throwError
177 catchError = Lift.liftCatch Mtl.catchError
182 catchError = Lift.liftCatch Mtl.catchError
src/Ether/Writer.hs+6−6
@@ -46,7 +46,7 @@ import qualified Control.Monad.Writer as T
46import Data.Coerce
46import Data.Coerce
47import Data.Functor.Identity
47import Data.Functor.Identity
48
48
49−import Ether.Handler
49+import Ether.TaggedTrans
50import Ether.Internal
50import Ether.Internal
51
51
52class (Monoid w, Monad m) => MonadWriter tag w m | m tag -> w where
52class (Monoid w, Monad m) => MonadWriter tag w m | m tag -> w where
@@ -117,7 +117,7 @@ type Writer tag w = WriterT tag w Identity
117--
117--
118-- The 'return' function produces the output 'mempty', while '>>=' combines
118-- The 'return' function produces the output 'mempty', while '>>=' combines
119-- the outputs of the subcomputations using 'mappend'.
119-- 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)
121
121
122-- | Constructor for computations in the writer monad transformer.
122-- | Constructor for computations in the writer monad transformer.
123writerT :: forall tag w m a . m (a, w) -> WriterT tag w m a
123writerT :: 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
154instance
154instance
155 ( Handle WRITER w trans
155 ( Handle WRITER w trans
156 , Monad m, Monad (trans m)
156 , 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)
158 where
158 where
159
159
160 writer =
160 writer =
161 handling @WRITER @w @trans @m $
161 handling @WRITER @w @trans @m $
162 coerce (T.writer @w @(trans m) @a) ::
162 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
164 {-# INLINE writer #-}
164 {-# INLINE writer #-}
165
165
166 tell =
166 tell =
@@ -171,13 +171,13 @@ instance
171 listen =
171 listen =
172 handling @WRITER @w @trans @m $
172 handling @WRITER @w @trans @m $
173 coerce (T.listen @w @(trans m) @a) ::
173 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
175 {-# INLINE listen #-}
175 {-# INLINE listen #-}
176
176
177 pass =
177 pass =
178 handling @WRITER @w @trans @m $
178 handling @WRITER @w @trans @m $
179 coerce (T.pass @w @(trans m) @a) ::
179 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
181 {-# INLINE pass #-}
181 {-# INLINE pass #-}
182
182
183type Writer' w = Writer w w
183type Writer' w = Writer w w