git.iko.soy/typeable/ether
on master help sign in
Unify TaggedTrans and DispatchT
commit0cd5cd688a9af2a4b65e02921422228252f39433 authorIndex Int <vlad.z.4096@gmail.com> dateSat 14 May 2016, 12:52 (10 years ago) parent6d9e3d9
26 files changed+544−841
compare with master
unifiedsplit
ether-flatten/src/Control/Ether/Flatten.hs+5−4 ether-flatten/src/Control/Monad/Ether/Reader/Flatten.hs+38−24 ether-zoom/ether-zoom.cabal+1 ether-zoom/src/Control/Monad/Ether/State/Zoom.hs+17−11 ether/ether.cabal+2−7 ether/src/Control/Monad/Ether.hs+2−1 ether/src/Control/Monad/Ether/Except.hs+45−2 ether/src/Control/Monad/Ether/Except/Class.hs−5 ether/src/Control/Monad/Ether/Implicit.hs+2−1 ether/src/Control/Monad/Ether/Reader.hs+49−1 ether/src/Control/Monad/Ether/Reader/Class.hs−6 ether/src/Control/Monad/Ether/State/Class.hs−12 ether/src/Control/Monad/Ether/State/Lazy.hs+69−1 ether/src/Control/Monad/Ether/State/Strict.hs+69−1 ether/src/Control/Monad/Ether/TagAttach.hs+72 ether/src/Control/Monad/Ether/TagReplace.hs+67 ether/src/Control/Monad/Ether/Writer.hs+59−1 ether/src/Control/Monad/Ether/Writer/Class.hs−7 ether/src/Control/Monad/Trans/Ether/Dispatch.hs+47−177 ether/src/Control/Monad/Trans/Ether/Except.hs−70 ether/src/Control/Monad/Trans/Ether/Reader.hs−79 ether/src/Control/Monad/Trans/Ether/State.hs−8 ether/src/Control/Monad/Trans/Ether/State/Lazy.hs−93 ether/src/Control/Monad/Trans/Ether/State/Strict.hs−93 ether/src/Control/Monad/Trans/Ether/Tagged.hs−150 ether/src/Control/Monad/Trans/Ether/Writer.hs−87
ether-flatten/src/Control/Ether/Flatten.hs+5−4
@@ -58,7 +58,8 @@ instance a ~ b => HasLens tag (Product (tag ': tags) (a ': as)) b where
5858 {-# INLINE lensOf #-}
5959
6060instance {-# OVERLAPPABLE #-}
61− ( HasLens tag (Product tags as) a
62− ) => HasLens tag (Product (t ': tags) (b ': as)) a where
63− lensOf t = productTail . lensOf t
64− {-# INLINE lensOf #-}
61+ ( HasLens tag (Product tags as) a
62+ ) => HasLens tag (Product (t ': tags) (b ': as)) a
63+ where
64+ lensOf t = productTail . lensOf t
65+ {-# INLINE lensOf #-}
ether-flatten/src/Control/Monad/Ether/Reader/Flatten.hs+38−24
@@ -24,43 +24,57 @@ import qualified Control.Monad.Trans.Reader as T
2424import Control.Lens
2525import Control.Ether.Flatten
2626
27−data K_Flatten t = Flatten [t]
27+data K_FLATTEN t = FLATTEN [t]
2828
29−type DispatchFlattenT ts = DispatchT (Flatten ts)
29+type FlattenT ts r = Dispatch (FLATTEN ts) (T.ReaderT r)
3030
3131reflatten
32− :: forall tagsOld tagsNew m a
33− . DispatchFlattenT tagsOld m a
34− -> DispatchFlattenT tagsNew m a
35−reflatten = redispatch
32+ :: forall tagsOld tagsNew r m a
33+ . FlattenT tagsOld r m a
34+ -> FlattenT tagsNew r m a
35+reflatten = repack
3636{-# INLINE reflatten #-}
3737
38−type DispatchFlattenReaderT ts r m = DispatchFlattenT ts (T.ReaderT r m)
38+instance
39+ ( Monad m, Monad (trans m)
40+ , Lift.MonadTrans trans
41+ , Lift.LiftLocal trans
42+ , C.MonadReader tag r m
43+ ) => C.MonadReader tag r (Dispatch (FLATTEN '[]) trans m)
44+ where
45+ ask t = Lift.lift (ask t)
46+ local t = Lift.liftLocal (ask t) (local t)
3947
40−instance (Monad m, C.MonadReader tag r m)
41− => C.MonadReader tag r (DispatchFlattenReaderT '[] payload m) where
42− ask t = Lift.lift (ask t)
43− local t = Lift.liftLocal (ask t) (local t)
44−
45−instance (Monad m, HasLens tag payload r)
46− => C.MonadReader tag r (DispatchFlattenReaderT (tag ': tags) payload m) where
47− ask t = dispatchT $ view (lensOf t)
48− local t f = dispatchT . T.local (over (lensOf t) f) . runDispatchT
48+instance
49+ ( Monad m, HasLens tag payload r
50+ , trans ~ T.ReaderT payload
51+ ) => C.MonadReader tag r (Dispatch (FLATTEN (tag ': tags)) trans m)
52+ where
53+ ask t = pack $ view (lensOf t)
54+ local t f = pack . T.local (over (lensOf t) f) . unpack
4955
5056instance {-# OVERLAPPABLE #-}
51− (Monad m, C.MonadReader tag r (DispatchFlattenReaderT tags payload m))
52− => C.MonadReader tag r (DispatchFlattenReaderT (t ': tags) payload m) where
53− ask t = reflatten @tags @(t ': tags) (C.ask t)
54− local t f = reflatten @tags @(t ': tags) . C.local t f . reflatten @(t ': tags) @tags
57+ ( Monad m
58+ , C.MonadReader tag r (Dispatch (FLATTEN tags) trans m)
59+ , trans ~ T.ReaderT payload
60+ ) => C.MonadReader tag r (Dispatch (FLATTEN (t ': tags)) trans m)
61+ where
62+ ask t = reflatten @tags @(t ': tags) (C.ask t)
63+ {-# INLINE ask #-}
64+ local t f
65+ = reflatten @tags @(t ': tags)
66+ . C.local t f
67+ . reflatten @(t ': tags) @tags
68+ {-# INLINE local #-}
5569
5670runReaderT
57− :: DispatchFlattenReaderT tags (Product tags as) m a
71+ :: FlattenT tags (Product tags as) m a
5872 -> Product tags as
5973 -> m a
60−runReaderT m = T.runReaderT (runDispatchT m)
74+runReaderT m = T.runReaderT (unpack m)
6175
6276runReader
63− :: DispatchFlattenReaderT tags (Product tags as) Identity a
77+ :: FlattenT tags (Product tags as) Identity a
6478 -> Product tags as
6579 -> a
66−runReader m = T.runReader (runDispatchT m)
80+runReader m = T.runReader (unpack m)
ether-zoom/ether-zoom.cabal+1
@@ -26,6 +26,7 @@ library
2626 exposed-modules: Control.Monad.Ether.State.Zoom
2727 build-depends: base >=4.9 && <4.10
2828 , ether >=0.5 && <0.6
29+ , transformers >=0.5
2930 , lens >=4.14
3031 , reflection >=2.1
3132
ether-zoom/src/Control/Monad/Ether/State/Zoom.hs+17−11
@@ -6,34 +6,40 @@
66{-# LANGUAGE FlexibleInstances #-}
77{-# LANGUAGE FlexibleContexts #-}
88{-# LANGUAGE UndecidableInstances #-}
9+{-# LANGUAGE TypeFamilies #-}
910
1011module Control.Monad.Ether.State.Zoom
11− ( K_TagZoom(..)
12+ ( K_TAG_ZOOM(..)
13+ , TagZoomT
1214 , tagZoom
1315 ) where
1416
1517import Control.Lens
1618import Data.Reflection
1719import Control.Monad.Trans.Ether.Dispatch
20+import Control.Monad.Trans.Identity
1821import Control.Monad.Ether.State.Class
1922import Data.Proxy
2023
2124-- | Encode type-level information for 'tagZoom'.
22−data K_TagZoom t z = TagZoom t z
25+data K_TAG_ZOOM t z = TAG_ZOOM t z
2326
24−type DispatchTagZoomT t (z :: *) = DispatchT (TagZoom t z)
27+type TagZoomT t (z :: *) = Dispatch (TAG_ZOOM t z) IdentityT
2528
2629-- | Zoom into a part of a state using a lens.
2730tagZoom
2831 :: forall tag sOuter sInner m a
2932 . Lens' sOuter sInner
30− -> (forall z . Reifies z (ReifiedLens' sOuter sInner) => DispatchTagZoomT tag z m a)
33+ -> (forall z . Reifies z (ReifiedLens' sOuter sInner) => TagZoomT tag z m a)
3134 -> m a
32−tagZoom l m = reify (Lens l) (\(_ :: Proxy z) -> runDispatchT (m @z))
35+tagZoom l m = reify (Lens l) (\(_ :: Proxy z) -> (runIdentityT . unpack) (m @z))
3336
34−instance ( MonadState tag sOuter m
35− , Reifies z (ReifiedLens' sOuter sInner)
36− ) => MonadState tag sInner (DispatchTagZoomT tag z m) where
37− state t = dispatchT . state t . l
38− where
39− Lens l = reflect (Proxy :: Proxy z)
37+instance
38+ ( MonadState tag sOuter m
39+ , Reifies z (ReifiedLens' sOuter sInner)
40+ , trans ~ IdentityT
41+ ) => MonadState tag sInner (Dispatch (TAG_ZOOM tag z) trans m)
42+ where
43+ state t =
44+ let Lens l = reflect (Proxy :: Proxy z)
45+ in pack . IdentityT . state t . l
ether/ether.cabal+2−7
@@ -28,15 +28,10 @@ library
2828
2929 exposed-modules: Control.Ether.Abbr
3030 Control.Ether.Implicit.Abbr
31− Control.Monad.Trans.Ether.Reader
32− Control.Monad.Trans.Ether.Writer
33− Control.Monad.Trans.Ether.State
34− Control.Monad.Trans.Ether.State.Lazy
35− Control.Monad.Trans.Ether.State.Strict
36− Control.Monad.Trans.Ether.Except
3731 Control.Monad.Trans.Ether.Dispatch
38− Control.Monad.Trans.Ether.Tagged
3932 Control.Monad.Ether
33+ Control.Monad.Ether.TagAttach
34+ Control.Monad.Ether.TagReplace
4035 Control.Monad.Ether.Reader
4136 Control.Monad.Ether.Reader.Class
4237 Control.Monad.Ether.Writer
ether/src/Control/Monad/Ether.hs+2−1
@@ -10,4 +10,5 @@ import Control.Monad.Ether.Reader as X
1010import Control.Monad.Ether.Writer as X
1111import Control.Monad.Ether.State as X
1212import Control.Monad.Ether.Except as X
13−import Control.Monad.Trans.Ether.Dispatch as X (tagAttach, tagReplace)
13+import Control.Monad.Ether.TagAttach as X
14+import Control.Monad.Ether.TagReplace as X
ether/src/Control/Monad/Ether/Except.hs+45−2
@@ -1,3 +1,9 @@
1+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
2+
3+{-# LANGUAGE DataKinds #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE UndecidableInstances #-}
6+{-# LANGUAGE TypeFamilies #-}
17{-# LANGUAGE AllowAmbiguousTypes #-}
28{-# LANGUAGE MagicHash #-}
39
@@ -24,8 +30,9 @@ module Control.Monad.Ether.Except
2430import GHC.Prim (Proxy#, proxy#)
2531import Control.Monad.Ether.Except.Class (MonadExcept)
2632import qualified Control.Monad.Ether.Except.Class as C
27−import Control.Monad.Trans.Ether.Except hiding (throw, catch)
28−import Data.Functor.Identity (Identity(..))
33+import qualified Control.Monad.Trans.Ether.Dispatch as D
34+import qualified Control.Monad.Trans.Except as T
35+import Data.Functor.Identity
2936
3037-- | Is used within a monadic computation to begin exception processing.
3138throw :: forall tag e m a . MonadExcept tag e m => e -> m a
@@ -43,3 +50,39 @@ handle h m = runIdentity (handleT @tag h m)
4350-- | Runs an 'ExceptT' and handles the exception with the given function.
4451handleT :: forall tag e m a . Functor m => (e -> a) -> ExceptT tag e m a -> m a
4552handleT h m = fmap (either h id) (runExceptT @tag m)
53+
54+-- | Encode type-level information for 'ExceptT'.
55+data K_EXCEPT t e = EXCEPT t e
56+
57+-- | The parameterizable exception monad.
58+--
59+-- Computations are either exceptions or normal values.
60+--
61+-- The 'return' function returns a normal value, while '>>=' exits on
62+-- the first exception.
63+type Except tag e = ExceptT tag e Identity
64+
65+-- | The exception monad transformer.
66+--
67+-- The 'return' function returns a normal value, while '>>=' exits on
68+-- the first exception.
69+type ExceptT tag e = D.Dispatch (EXCEPT tag e) (T.ExceptT e)
70+
71+-- | Runs an 'Except' and returns either an exception or a normal value.
72+runExcept :: forall tag e a . Except tag e a -> Either e a
73+runExcept = T.runExcept . D.unpack
74+
75+-- | Runs an 'ExceptT' and returns either an exception or a normal value.
76+runExceptT :: forall tag e m a . ExceptT tag e m a -> m (Either e a)
77+runExceptT = T.runExceptT . D.unpack
78+
79+-- | Constructor for computations in the exception monad transformer.
80+exceptT :: forall tag e m a . m (Either e a) -> ExceptT tag e m a
81+exceptT = D.pack . T.ExceptT
82+
83+instance
84+ ( Monad m, e ~ e', trans ~ T.ExceptT e
85+ ) => MonadExcept tag e (D.Dispatch (EXCEPT tag e') trans m)
86+ where
87+ throw _ = D.pack . T.throwE
88+ catch _ m h = D.pack $ T.catchE (D.unpack m) (D.unpack . h)
ether/src/Control/Monad/Ether/Except/Class.hs−5
@@ -10,7 +10,6 @@ module Control.Monad.Ether.Except.Class
1010 ) where
1111
1212import GHC.Prim (Proxy#)
13−import qualified Control.Monad.Trans.Ether.Except as E
1413import qualified Control.Monad.Trans.Lift.Catch as Lift
1514
1615-- | See 'Control.Monad.Except.MonadError'.
@@ -23,10 +22,6 @@ class Monad m => MonadExcept tag e m | m tag -> e where
2322 -- normal execution.
2423 catch :: Proxy# tag -> m a -> (e -> m a) -> m a
2524
26−instance (Monad m, e ~ e') => MonadExcept tag e (E.ExceptT tag e' m) where
27− throw _ = E.throw @tag
28− catch _ = E.catch @tag
29−
3025instance {-# OVERLAPPABLE #-}
3126 ( Lift.LiftCatch t
3227 , Monad (t m)
ether/src/Control/Monad/Ether/Implicit.hs+2−1
@@ -10,4 +10,5 @@ import Control.Monad.Ether.Implicit.Reader as X
1010import Control.Monad.Ether.Implicit.Writer as X
1111import Control.Monad.Ether.Implicit.State as X
1212import Control.Monad.Ether.Implicit.Except as X
13−import Control.Monad.Trans.Ether.Dispatch as X
13+import Control.Monad.Ether.TagAttach as X
14+import Control.Monad.Ether.TagReplace as X
ether/src/Control/Monad/Ether/Reader.hs+49−1
@@ -1,3 +1,9 @@
1+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
2+
3+{-# LANGUAGE DataKinds #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE UndecidableInstances #-}
6+{-# LANGUAGE TypeFamilies #-}
17{-# LANGUAGE AllowAmbiguousTypes #-}
28{-# LANGUAGE MagicHash #-}
39
@@ -23,7 +29,9 @@ module Control.Monad.Ether.Reader
2329import GHC.Prim (Proxy#, proxy#)
2430import Control.Monad.Ether.Reader.Class (MonadReader)
2531import qualified Control.Monad.Ether.Reader.Class as C
26−import Control.Monad.Trans.Ether.Reader hiding (reader, ask, local)
32+import qualified Control.Monad.Trans.Ether.Dispatch as D
33+import qualified Control.Monad.Trans.Reader as T
34+import Data.Functor.Identity
2735
2836-- | Retrieves the monad environment.
2937ask :: forall tag r m . MonadReader tag r m => m r
@@ -57,3 +65,43 @@ asks
5765 -- ^ The selector function to apply to the environment.
5866 -> m a
5967asks = C.reader (proxy# :: Proxy# tag)
68+
69+-- | Encode type-level information for 'ReaderT'.
70+data K_READER t r = READER t r
71+
72+-- | The parameterizable reader monad.
73+--
74+-- Computations are functions of a shared environment.
75+--
76+-- The 'return' function ignores the environment, while '>>=' passes
77+-- the inherited environment to both subcomputations.
78+type Reader tag r = ReaderT tag r Identity
79+
80+-- | The reader monad transformer,
81+-- which adds a read-only environment to the given monad.
82+--
83+-- The 'return' function ignores the environment, while '>>=' passes
84+-- the inherited environment to both subcomputations.
85+type ReaderT tag r = D.Dispatch (READER tag r) (T.ReaderT r)
86+
87+-- | Constructor for computations in the reader monad transformer.
88+readerT :: forall tag r m a . (r -> m a) -> ReaderT tag r m a
89+readerT = D.pack . T.ReaderT
90+
91+-- | Runs a 'ReaderT' with the given environment
92+-- and returns the final value.
93+runReaderT :: forall tag r m a . ReaderT tag r m a -> r -> m a
94+runReaderT = T.runReaderT . D.unpack
95+
96+-- | Runs a 'ReaderT' with the given environment
97+-- and returns the final value.
98+runReader :: forall tag r a . Reader tag r a -> r -> a
99+runReader = T.runReader . D.unpack
100+
101+instance
102+ ( Monad m, r ~ r', trans ~ T.ReaderT r
103+ ) => MonadReader tag r (D.Dispatch (READER tag r') trans m)
104+ where
105+ ask _ = D.pack T.ask
106+ local _ f = D.pack . T.withReaderT f . D.unpack
107+ reader _ = D.pack . T.reader
ether/src/Control/Monad/Ether/Reader/Class.hs−6
@@ -10,7 +10,6 @@ module Control.Monad.Ether.Reader.Class
1010 ) where
1111
1212import GHC.Prim (Proxy#)
13−import qualified Control.Monad.Trans.Ether.Reader as R
1413import qualified Control.Monad.Trans.Lift.Local as Lift
1514
1615-- | See 'Control.Monad.Reader.MonadReader'.
@@ -39,11 +38,6 @@ class Monad m => MonadReader tag r m | m tag -> r where
3938 -> m a
4039 reader t f = fmap f (ask t)
4140
42−instance (Monad m, r ~ r') => MonadReader tag r (R.ReaderT tag r' m) where
43− ask _ = R.ask @tag
44− local _ = R.local @tag
45− reader _ = R.reader @tag
46−
4741instance {-# OVERLAPPABLE #-}
4842 ( Lift.LiftLocal t
4943 , Monad (t m)
ether/src/Control/Monad/Ether/State/Class.hs−12
@@ -10,8 +10,6 @@ module Control.Monad.Ether.State.Class
1010 ) where
1111
1212import GHC.Prim (Proxy#)
13−import qualified Control.Monad.Trans.Ether.State.Lazy as S.L
14−import qualified Control.Monad.Trans.Ether.State.Strict as S.S
1513import qualified Control.Monad.Trans as Lift
1614
1715-- | See 'Control.Monad.State.MonadState'.
@@ -35,16 +33,6 @@ class Monad m => MonadState tag s m | m tag -> s where
3533 put t s'
3634 return a
3735
38−instance (Monad m, s ~ s') => MonadState tag s (S.L.StateT tag s' m) where
39− get _ = S.L.get @tag
40− put _ = S.L.put @tag
41− state _ = S.L.state @tag
42−
43−instance (Monad m, s ~ s') => MonadState tag s (S.S.StateT tag s' m) where
44− get _ = S.S.get @tag
45− put _ = S.S.put @tag
46− state _ = S.S.state @tag
47−
4836instance {-# OVERLAPPABLE #-}
4937 ( Lift.MonadTrans t
5038 , Monad (t m)
ether/src/Control/Monad/Ether/State/Lazy.hs+69−1
@@ -1,3 +1,9 @@
1+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
2+
3+{-# LANGUAGE DataKinds #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE UndecidableInstances #-}
6+{-# LANGUAGE TypeFamilies #-}
17
28-- | See "Control.Monad.State.Lazy".
39
@@ -24,4 +30,66 @@ module Control.Monad.Ether.State.Lazy
2430 ) where
2531
2632import Control.Monad.Ether.State.Common
27−import Control.Monad.Trans.Ether.State.Lazy hiding (state, get, put)
33+import qualified Control.Monad.Ether.State.Class as C
34+import qualified Control.Monad.Trans.Ether.Dispatch as D
35+import qualified Control.Monad.Trans.State.Lazy as T
36+import Data.Functor.Identity
37+
38+-- | Encode type-level information for 'StateT'.
39+data K_STATE t s = STATE t s
40+
41+-- | The parametrizable state monad.
42+--
43+-- Computations have access to a mutable state.
44+--
45+-- The 'return' function leaves the state unchanged, while '>>=' uses
46+-- the final state of the first computation as the initial state of the second.
47+type State tag r = StateT tag r Identity
48+
49+-- | The state monad transformer.
50+--
51+-- The 'return' function leaves the state unchanged, while '>>=' uses
52+-- the final state of the first computation as the initial state of the second.
53+type StateT tag s = D.Dispatch (STATE tag s) (T.StateT s)
54+
55+-- | Constructor for computations in the state monad transformer.
56+stateT :: forall tag s m a . (s -> m (a, s)) -> StateT tag s m a
57+stateT = D.pack . T.StateT
58+
59+-- | Runs a 'StateT' with the given initial state
60+-- and returns both the final value and the final state.
61+runStateT :: forall tag s m a . StateT tag s m a -> s -> m (a, s)
62+runStateT = T.runStateT . D.unpack
63+
64+-- | Runs a 'StateT' with the given initial state
65+-- and returns the final value, discarding the final state.
66+evalStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m a
67+evalStateT = T.evalStateT . D.unpack
68+
69+-- | Runs a 'StateT' with the given initial state
70+-- and returns the final state, discarding the final value.
71+execStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m s
72+execStateT = T.execStateT . D.unpack
73+
74+-- | Runs a 'State' with the given initial state
75+-- and returns both the final value and the final state.
76+runState :: forall tag s a . State tag s a -> s -> (a, s)
77+runState = T.runState . D.unpack
78+
79+-- | Runs a 'State' with the given initial state
80+-- and returns the final value, discarding the final state.
81+evalState :: forall tag s a . State tag s a -> s -> a
82+evalState = T.evalState . D.unpack
83+
84+-- | Runs a 'State' with the given initial state
85+-- and returns the final state, discarding the final value.
86+execState :: forall tag s a . State tag s a -> s -> s
87+execState = T.execState . D.unpack
88+
89+instance
90+ ( Monad m, s ~ s', trans ~ T.StateT s
91+ ) => MonadState tag s (D.Dispatch (STATE tag s') trans m)
92+ where
93+ get _ = D.pack T.get
94+ put _ = D.pack . T.put
95+ state _ = D.pack . T.state
ether/src/Control/Monad/Ether/State/Strict.hs+69−1
@@ -1,3 +1,9 @@
1+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
2+
3+{-# LANGUAGE DataKinds #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE UndecidableInstances #-}
6+{-# LANGUAGE TypeFamilies #-}
17
28-- | See "Control.Monad.State.Strict".
39
@@ -24,4 +30,66 @@ module Control.Monad.Ether.State.Strict
2430 ) where
2531
2632import Control.Monad.Ether.State.Common
27−import Control.Monad.Trans.Ether.State.Strict hiding (state, get, put)
33+import qualified Control.Monad.Ether.State.Class as C
34+import qualified Control.Monad.Trans.Ether.Dispatch as D
35+import qualified Control.Monad.Trans.State.Strict as T
36+import Data.Functor.Identity
37+
38+-- | Encode type-level information for 'StateT'.
39+data K_STATE t s = STATE t s
40+
41+-- | The parametrizable state monad.
42+--
43+-- Computations have access to a mutable state.
44+--
45+-- The 'return' function leaves the state unchanged, while '>>=' uses
46+-- the final state of the first computation as the initial state of the second.
47+type State tag r = StateT tag r Identity
48+
49+-- | The state monad transformer.
50+--
51+-- The 'return' function leaves the state unchanged, while '>>=' uses
52+-- the final state of the first computation as the initial state of the second.
53+type StateT tag s = D.Dispatch (STATE tag s) (T.StateT s)
54+
55+-- | Constructor for computations in the state monad transformer.
56+stateT :: forall tag s m a . (s -> m (a, s)) -> StateT tag s m a
57+stateT = D.pack . T.StateT
58+
59+-- | Runs a 'StateT' with the given initial state
60+-- and returns both the final value and the final state.
61+runStateT :: forall tag s m a . StateT tag s m a -> s -> m (a, s)
62+runStateT = T.runStateT . D.unpack
63+
64+-- | Runs a 'StateT' with the given initial state
65+-- and returns the final value, discarding the final state.
66+evalStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m a
67+evalStateT = T.evalStateT . D.unpack
68+
69+-- | Runs a 'StateT' with the given initial state
70+-- and returns the final state, discarding the final value.
71+execStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m s
72+execStateT = T.execStateT . D.unpack
73+
74+-- | Runs a 'State' with the given initial state
75+-- and returns both the final value and the final state.
76+runState :: forall tag s a . State tag s a -> s -> (a, s)
77+runState = T.runState . D.unpack
78+
79+-- | Runs a 'State' with the given initial state
80+-- and returns the final value, discarding the final state.
81+evalState :: forall tag s a . State tag s a -> s -> a
82+evalState = T.evalState . D.unpack
83+
84+-- | Runs a 'State' with the given initial state
85+-- and returns the final state, discarding the final value.
86+execState :: forall tag s a . State tag s a -> s -> s
87+execState = T.execState . D.unpack
88+
89+instance
90+ ( Monad m, s ~ s', trans ~ T.StateT s
91+ ) => MonadState tag s (D.Dispatch (STATE tag s') trans m)
92+ where
93+ get _ = D.pack T.get
94+ put _ = D.pack . T.put
95+ state _ = D.pack . T.state
ether/src/Control/Monad/Ether/TagAttach.hsnew file+72
@@ -0,0 +1,72 @@
1+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
2+
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE TypeFamilies #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE UndecidableInstances #-}
7+{-# LANGUAGE DataKinds #-}
8+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
9+
10+module Control.Monad.Ether.TagAttach
11+ ( K_TAG_ATTACH(..)
12+ , TagAttachT
13+ , tagAttach
14+ ) where
15+
16+import Control.Monad.Trans.Identity
17+
18+import Control.Monad.Ether.Reader.Class
19+import Control.Monad.Ether.State.Class
20+import Control.Monad.Ether.Except.Class
21+import Control.Monad.Ether.Writer.Class
22+
23+import Control.Monad.Ether.Reader as A
24+import Control.Monad.Ether.State.Common as A
25+import Control.Monad.Ether.Except as A
26+import Control.Monad.Ether.Writer as A
27+
28+import qualified Control.Monad.Reader.Class as Class
29+import qualified Control.Monad.State.Class as Class
30+import qualified Control.Monad.Writer.Class as Class
31+import qualified Control.Monad.Error.Class as Class
32+
33+import Control.Monad.Trans.Ether.Dispatch
34+
35+-- | Encode type-level information for 'tagAttach'.
36+data K_TAG_ATTACH t = TAG_ATTACH t
37+
38+type TagAttachT t = Dispatch (TAG_ATTACH t) IdentityT
39+
40+-- | Attach a tag to untagged transformers.
41+tagAttach :: forall tag m a . TagAttachT tag m a -> m a
42+tagAttach = runIdentityT . unpack
43+
44+instance
45+ ( MonadReader tag r m, trans ~ IdentityT
46+ ) => Class.MonadReader r (Dispatch (TAG_ATTACH tag) trans m)
47+ where
48+ ask = A.ask @tag
49+ local = A.local @tag
50+
51+instance
52+ ( MonadState tag s m, trans ~ IdentityT
53+ ) => Class.MonadState s (Dispatch (TAG_ATTACH tag) trans m)
54+ where
55+ get = A.get @tag
56+ put = A.put @tag
57+
58+instance
59+ ( MonadExcept tag e m, trans ~ IdentityT
60+ ) => Class.MonadError e (Dispatch (TAG_ATTACH tag) trans m)
61+ where
62+ throwError = A.throw @tag
63+ catchError = A.catch @tag
64+
65+instance
66+ ( MonadWriter tag w m, trans ~ IdentityT
67+ ) => Class.MonadWriter w (Dispatch (TAG_ATTACH tag) trans m)
68+ where
69+ writer = A.writer @tag
70+ tell = A.tell @tag
71+ listen = A.listen @tag
72+ pass = A.pass @tag
ether/src/Control/Monad/Ether/TagReplace.hsnew file+67
@@ -0,0 +1,67 @@
1+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
2+
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE TypeFamilies #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE UndecidableInstances #-}
7+{-# LANGUAGE DataKinds #-}
8+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
9+
10+module Control.Monad.Ether.TagReplace
11+ ( K_TAG_REPLACE(..)
12+ , TagReplaceT
13+ , tagReplace
14+ ) where
15+
16+import Control.Monad.Trans.Identity
17+
18+import Control.Monad.Ether.Reader.Class
19+import Control.Monad.Ether.State.Class
20+import Control.Monad.Ether.Except.Class
21+import Control.Monad.Ether.Writer.Class
22+
23+import Control.Monad.Ether.Reader as A
24+import Control.Monad.Ether.State.Common as A
25+import Control.Monad.Ether.Except as A
26+import Control.Monad.Ether.Writer as A
27+
28+import Control.Monad.Trans.Ether.Dispatch
29+
30+-- | Encode type-level information for 'tagReplace'.
31+data K_TAG_REPLACE tOld tNew = TAG_REPLACE tOld tNew
32+
33+type TagReplaceT tOld tNew = Dispatch (TAG_REPLACE tOld tNew) IdentityT
34+
35+-- | Replace a tag with another tag.
36+tagReplace :: forall tOld tNew m a . TagReplaceT tOld tNew m a -> m a
37+tagReplace = runIdentityT . unpack
38+
39+instance
40+ ( MonadReader tNew r m, trans ~ IdentityT
41+ ) => MonadReader tOld r (Dispatch (TAG_REPLACE tOld tNew) trans m)
42+ where
43+ ask _ = A.ask @tNew
44+ local _ = A.local @tNew
45+
46+instance
47+ ( MonadState tNew s m, trans ~ IdentityT
48+ ) => MonadState tOld s (Dispatch (TAG_REPLACE tOld tNew) trans m)
49+ where
50+ get _ = A.get @tNew
51+ put _ = A.put @tNew
52+
53+instance
54+ ( MonadExcept tNew e m, trans ~ IdentityT
55+ ) => MonadExcept tOld e (Dispatch (TAG_REPLACE tOld tNew) trans m)
56+ where
57+ throw _ = A.throw @tNew
58+ catch _ = A.catch @tNew
59+
60+instance
61+ ( MonadWriter tNew w m, trans ~ IdentityT
62+ ) => MonadWriter tOld w (Dispatch (TAG_REPLACE tOld tNew) trans m)
63+ where
64+ writer _ = A.writer @tNew
65+ tell _ = A.tell @tNew
66+ listen _ = A.listen @tNew
67+ pass _ = A.pass @tNew
ether/src/Control/Monad/Ether/Writer.hs+59−1
@@ -1,3 +1,9 @@
1+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
2+
3+{-# LANGUAGE DataKinds #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE UndecidableInstances #-}
6+{-# LANGUAGE TypeFamilies #-}
17{-# LANGUAGE AllowAmbiguousTypes #-}
28{-# LANGUAGE MagicHash #-}
39
@@ -27,7 +33,9 @@ module Control.Monad.Ether.Writer
2733import GHC.Prim (Proxy#, proxy#)
2834import Control.Monad.Ether.Writer.Class (MonadWriter)
2935import qualified Control.Monad.Ether.Writer.Class as C
30−import Control.Monad.Trans.Ether.Writer hiding (writer, tell, listen, pass)
36+import qualified Control.Monad.Trans.Ether.Dispatch as D
37+import qualified Control.Monad.Trans.Writer as T
38+import Data.Functor.Identity
3139
3240-- | Embed a simple writer action.
3341writer :: forall tag w m a . MonadWriter tag w m => (a, w) -> m a
@@ -59,3 +67,53 @@ censor :: forall tag w m a . MonadWriter tag w m => (w -> w) -> m a -> m a
5967censor f m = pass @tag $ do
6068 a <- m
6169 return (a, f)
70+
71+-- | Encode type-level information for 'WriterT'.
72+data K_WRITER t w = WRITER t w
73+
74+-- | The parametrizable writer monad.
75+--
76+-- Computations can accumulate a monoid value.
77+--
78+-- The 'return' function produces the output 'mempty', while '>>=' combines
79+-- the outputs of the subcomputations using 'mappend'.
80+type Writer tag w = WriterT tag w Identity
81+
82+-- | The writer monad transformer.
83+--
84+-- The 'return' function produces the output 'mempty', while '>>=' combines
85+-- the outputs of the subcomputations using 'mappend'.
86+type WriterT tag w = D.Dispatch (WRITER tag w) (T.WriterT w)
87+
88+-- | Constructor for computations in the writer monad transformer.
89+writerT :: forall tag w m a . m (a, w) -> WriterT tag w m a
90+writerT = D.pack . T.WriterT
91+
92+-- | Runs a 'WriterT' and returns both the normal value
93+-- and the final accumulator.
94+runWriterT :: forall tag w m a . WriterT tag w m a -> m (a, w)
95+runWriterT = T.runWriterT . D.unpack
96+
97+-- | Runs a 'Writer' and returns both the normal value
98+-- and the final accumulator.
99+runWriter :: forall tag w a . Writer tag w a -> (a, w)
100+runWriter = T.runWriter . D.unpack
101+
102+-- | Runs a 'WriterT' and returns the final accumulator,
103+-- discarding the normal value.
104+execWriterT :: forall tag w m a . Monad m => WriterT tag w m a -> m w
105+execWriterT = T.execWriterT . D.unpack
106+
107+-- | Runs a 'Writer' and returns the final accumulator,
108+-- discarding the normal value.
109+execWriter :: forall tag w a . Writer tag w a -> w
110+execWriter = T.execWriter . D.unpack
111+
112+instance
113+ ( Monoid w, Monad m, w ~ w', trans ~ T.WriterT w
114+ ) => MonadWriter tag w (D.Dispatch (WRITER tag w') trans m)
115+ where
116+ writer _ = D.pack . T.writer
117+ tell _ = D.pack . T.tell
118+ listen _ = D.pack . T.listen . D.unpack
119+ pass _ = D.pack . T.pass . D.unpack
ether/src/Control/Monad/Ether/Writer/Class.hs−7
@@ -10,7 +10,6 @@ module Control.Monad.Ether.Writer.Class
1010 ) where
1111
1212import GHC.Prim (Proxy#)
13−import qualified Control.Monad.Trans.Ether.Writer as W
1413import qualified Control.Monad.Trans.Lift.Listen as Lift
1514import qualified Control.Monad.Trans.Lift.Pass as Lift
1615
@@ -37,12 +36,6 @@ class (Monoid w, Monad m) => MonadWriter tag w m | m tag -> w where
3736 -- and return the value, applying the function to the accumulator.
3837 pass :: Proxy# tag -> m (a, w -> w) -> m a
3938
40−instance (Monoid w, Monad m, w ~ w') => MonadWriter tag w (W.WriterT tag w' m) where
41− writer _ = W.writer @tag
42− tell _ = W.tell @tag
43− listen _ = W.listen @tag
44− pass _ = W.pass @tag
45−
4639instance {-# OVERLAPPABLE #-}
4740 ( Lift.LiftListen t
4841 , Lift.LiftPass t
ether/src/Control/Monad/Trans/Ether/Dispatch.hs+47−177
@@ -1,57 +1,11 @@
1−{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
2−
31{-# LANGUAGE DeriveGeneric #-}
4−{-# LANGUAGE TypeFamilies #-}
2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
53{-# LANGUAGE FlexibleInstances #-}
64{-# LANGUAGE UndecidableInstances #-}
7−{-# LANGUAGE DataKinds #-}
8−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
9−
10−{- |
11−
12−Type-level machinery to manipulate constraints on the monad
13−transformer stack.
14−
15−Out of the box it provides the following dispatch strategies:
16−
17−* 'tagAttach' to use functions defined using untagged monad classes
18− as if they were defined using tagged ones.
19−
20−* 'tagReplace' to use functions defined using one tag
21− as if they were defined using another one.
22−
23−> import qualified Control.Monad.State as T
24−> import Control.Ether.TH (ethereal)
25−> import Control.Monad.Ether.State (MonadState)
26−> import Control.Monad.Trans.Ether.Dispatch (tagAttach, tagDispatch)
27−>
28−> ethereal "Foo" "foo"
29−> ethereal "Bar" "bar"
30−>
31−> f :: T.MonadState Int m => m String
32−> f = fmap show T.get
33−>
34−> g :: MonadState Foo Int m => m String
35−> g = tagAttach foo f
36−>
37−> h :: MonadState Bar Int m => m String
38−> h = tagReplace foo bar g
39−
40−-}
5+{-# LANGUAGE ConstraintKinds #-}
6+{-# LANGUAGE TypeFamilies #-}
417
42−module Control.Monad.Trans.Ether.Dispatch
43− (
44− -- * The DispatchT monad transformer
45− DispatchT
46− , dispatchT
47− , runDispatchT
48− , redispatch
49− -- * Dispatch types and functions
50− , K_TagAttach(..)
51− , tagAttach
52− , K_TagReplace(..)
53− , tagReplace
54− ) where
8+module Control.Monad.Trans.Ether.Dispatch where
559
5610import Control.Applicative
5711import Control.Monad (MonadPlus)
@@ -63,7 +17,6 @@ import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
6317
6418import qualified Control.Monad.Base as MB
6519import qualified Control.Monad.Trans.Control as MC
66−import qualified Control.Monad.Trans.Identity as Trans
6720
6821import qualified Control.Monad.Trans.Lift.StT as Lift
6922import qualified Control.Monad.Trans.Lift.Local as Lift
@@ -72,16 +25,6 @@ import qualified Control.Monad.Trans.Lift.Listen as Lift
7225import qualified Control.Monad.Trans.Lift.Pass as Lift
7326import qualified Control.Monad.Trans.Lift.CallCC as Lift
7427
75−import Control.Monad.Ether.Reader.Class
76−import Control.Monad.Ether.State.Class
77−import Control.Monad.Ether.Except.Class
78−import Control.Monad.Ether.Writer.Class
79−
80−import Control.Monad.Ether.Reader as A
81−import Control.Monad.Ether.State.Common as A
82−import Control.Monad.Ether.Except as A
83−import Control.Monad.Ether.Writer as A
84−
8528import qualified Control.Monad.Cont.Class as Class
8629import qualified Control.Monad.Reader.Class as Class
8730import qualified Control.Monad.State.Class as Class
@@ -91,84 +34,75 @@ import qualified Control.Monad.Error.Class as Class
9134import GHC.Generics (Generic)
9235import Data.Coerce (coerce)
9336
94−-- | Wrap a monad to change its tags. Under the hood this is
95−-- simply 'Trans.IdentityT', all the work is happening on the type level.
96−newtype DispatchT dp m a = DispatchT (Trans.IdentityT m a)
37+newtype Dispatch dp trans m a = Dispatch (trans m a)
9738 deriving
9839 ( Generic
9940 , Functor, Applicative, Alternative, Monad, MonadPlus
10041 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad
10142 , MonadThrow, MonadCatch, MonadMask )
10243
103−-- | Type-restricted 'coerce'.
104−pack :: forall dp m a . Trans.IdentityT m a -> DispatchT dp m a
44+pack :: forall dp trans m a . trans m a -> Dispatch dp trans m a
10545pack = coerce
10646{-# INLINE pack #-}
10747
108−-- | Type-restricted 'coerce'.
109−unpack :: forall dp m a . DispatchT dp m a -> Trans.IdentityT m a
48+unpack :: forall dp trans m a . Dispatch dp trans m a -> trans m a
11049unpack = coerce
11150{-# INLINE unpack #-}
11251
113−-- | Type-restricted 'coerce'.
114−dispatchT :: forall dp m a . m a -> DispatchT dp m a
115−dispatchT = coerce
116−{-# INLINE dispatchT #-}
117−
118−-- | Type-restricted 'coerce'.
119−runDispatchT :: forall dp m a . DispatchT dp m a -> m a
120−runDispatchT = coerce
121−{-# INLINE runDispatchT #-}
52+repack :: forall dp dp' trans m a . Dispatch dp trans m a -> Dispatch dp' trans m a
53+repack = coerce
54+{-# INLINE repack #-}
12255
123−-- | Type-restricted 'coerce'.
124−redispatch :: forall dp dp' m a . DispatchT dp m a -> DispatchT dp' m a
125−redispatch = coerce
126−{-# INLINE redispatch #-}
127−
128−instance MB.MonadBase b m => MB.MonadBase b (DispatchT dp m) where
129− liftBase = MB.liftBaseDefault
130−
131−instance MC.MonadTransControl (DispatchT dp) where
132− type StT (DispatchT dp) a = MC.StT Trans.IdentityT a
133− liftWith = MC.defaultLiftWith pack unpack
134− restoreT = MC.defaultRestoreT pack
56+instance
57+ ( MB.MonadBase b m
58+ , MonadTrans trans
59+ , Monad (trans m)
60+ ) => MB.MonadBase b (Dispatch dp trans m)
61+ where
62+ liftBase = MB.liftBaseDefault
13563
136−instance MC.MonadBaseControl b m => MC.MonadBaseControl b (DispatchT dp m) where
137− type StM (DispatchT dp m) a = MC.ComposeSt (DispatchT dp) m a
138− liftBaseWith = MC.defaultLiftBaseWith
139− restoreM = MC.defaultRestoreM
64+instance
65+ ( MC.MonadTransControl trans
66+ ) => MC.MonadTransControl (Dispatch dp trans)
67+ where
68+ type StT (Dispatch dp trans) a = MC.StT trans a
69+ liftWith = MC.defaultLiftWith pack unpack
70+ restoreT = MC.defaultRestoreT pack
14071
141−type instance Lift.StT (DispatchT dp) a = MC.StT (DispatchT dp) a
72+type instance Lift.StT (Dispatch dp trans) a = Lift.StT trans a
14273
143−instance Lift.LiftLocal (DispatchT dp) where
74+instance Lift.LiftLocal trans => Lift.LiftLocal (Dispatch dp trans) where
14475 liftLocal = Lift.defaultLiftLocal pack unpack
14576
146−instance Lift.LiftCatch (DispatchT dp) where
77+instance Lift.LiftCatch trans => Lift.LiftCatch (Dispatch dp trans) where
14778 liftCatch = Lift.defaultLiftCatch pack unpack
14879
149−instance Lift.LiftListen (DispatchT dp) where
80+instance Lift.LiftListen trans => Lift.LiftListen (Dispatch dp trans) where
15081 liftListen = Lift.defaultLiftListen pack unpack
15182
152−instance Lift.LiftPass (DispatchT dp) where
83+instance Lift.LiftPass trans => Lift.LiftPass (Dispatch dp trans) where
15384 liftPass = Lift.defaultLiftPass pack unpack
15485
155−instance Lift.LiftCallCC (DispatchT dp) where
86+instance Lift.LiftCallCC trans => Lift.LiftCallCC (Dispatch dp trans) where
15687 liftCallCC = Lift.defaultLiftCallCC pack unpack
15788 liftCallCC' = Lift.defaultLiftCallCC' pack unpack
15889
90+
15991-- Instances for mtl classes
16092
16193instance {-# OVERLAPPABLE #-}
16294 ( Class.MonadCont m
163− , Monad m
164− ) => Class.MonadCont (DispatchT dp m)
95+ , Lift.LiftCallCC trans
96+ , Monad (trans m)
97+ ) => Class.MonadCont (Dispatch dp trans m)
16598 where
16699 callCC = Lift.liftCallCC' Class.callCC
167100
168101instance {-# OVERLAPPABLE #-}
169102 ( Class.MonadReader r m
170− , Monad m
171− ) => Class.MonadReader r (DispatchT dp m)
103+ , Lift.LiftLocal trans
104+ , Monad (trans m)
105+ ) => Class.MonadReader r (Dispatch dp trans m)
172106 where
173107 ask = lift Class.ask
174108 local = Lift.liftLocal Class.ask Class.local
@@ -176,8 +110,9 @@ instance {-# OVERLAPPABLE #-}
176110
177111instance {-# OVERLAPPABLE #-}
178112 ( Class.MonadState s m
179− , Monad m
180− ) => Class.MonadState s (DispatchT dp m)
113+ , MonadTrans trans
114+ , Monad (trans m)
115+ ) => Class.MonadState s (Dispatch dp trans m)
181116 where
182117 get = lift Class.get
183118 put = lift . Class.put
@@ -185,8 +120,10 @@ instance {-# OVERLAPPABLE #-}
185120
186121instance {-# OVERLAPPABLE #-}
187122 ( Class.MonadWriter w m
188− , Monad m
189− ) => Class.MonadWriter w (DispatchT dp m)
123+ , Lift.LiftListen trans
124+ , Lift.LiftPass trans
125+ , Monad (trans m)
126+ ) => Class.MonadWriter w (Dispatch dp trans m)
190127 where
191128 writer = lift . Class.writer
192129 tell = lift . Class.tell
@@ -195,76 +132,9 @@ instance {-# OVERLAPPABLE #-}
195132
196133instance {-# OVERLAPPABLE #-}
197134 ( Class.MonadError e m
198− , Monad m
199− ) => Class.MonadError e (DispatchT dp m)
135+ , Lift.LiftCatch trans
136+ , Monad (trans m)
137+ ) => Class.MonadError e (Dispatch dp trans m)
200138 where
201139 throwError = lift . Class.throwError
202140 catchError = Lift.liftCatch Class.catchError
203−
204−
205−-- TagAttach
206−
207−-- | Encode type-level information for 'tagAttach'.
208−data K_TagAttach t = TagAttach t
209−
210−type DispatchTagAttachT t = DispatchT (TagAttach t)
211−
212−-- | Attach a tag to untagged transformers.
213−tagAttach :: forall tag m a . DispatchTagAttachT tag m a -> m a
214−tagAttach = runDispatchT
215−
216−instance MonadReader tag r m
217− => Class.MonadReader r (DispatchTagAttachT tag m) where
218− ask = Lift.lift (A.ask @tag)
219− local = Lift.liftLocal (A.ask @tag) (A.local @tag)
220−
221−instance MonadState tag s m
222− => Class.MonadState s (DispatchTagAttachT tag m) where
223− get = Lift.lift (A.get @tag)
224− put = Lift.lift . A.put @tag
225−
226−instance MonadExcept tag e m
227− => Class.MonadError e (DispatchTagAttachT tag m) where
228− throwError = Lift.lift . A.throw @tag
229− catchError = Lift.liftCatch (A.catch @tag)
230−
231−instance MonadWriter tag w m
232− => Class.MonadWriter w (DispatchTagAttachT tag m) where
233− writer = Lift.lift . A.writer @tag
234− tell = Lift.lift . A.tell @tag
235− listen = Lift.liftListen (A.listen @tag)
236− pass = Lift.liftPass (A.pass @tag)
237−
238−
239−-- TagReplace
240−
241−-- | Encode type-level information for 'tagReplace'.
242−data K_TagReplace tOld tNew = TagReplace tOld tNew
243−
244−type DispatchTagReplaceT tOld tNew = DispatchT (TagReplace tOld tNew)
245−
246−-- | Replace a tag with another tag.
247−tagReplace :: forall tOld tNew m a . DispatchTagReplaceT tOld tNew m a -> m a
248−tagReplace = runDispatchT
249−
250−instance MonadReader tNew r m
251− => MonadReader tOld r (DispatchTagReplaceT tOld tNew m) where
252− ask _ = Lift.lift (A.ask @tNew)
253− local _ = Lift.liftLocal (A.ask @tNew) (A.local @tNew)
254−
255−instance MonadState tNew s m
256− => MonadState tOld s (DispatchTagReplaceT tOld tNew m) where
257− get _ = Lift.lift (A.get @tNew)
258− put _ = Lift.lift . A.put @tNew
259−
260−instance MonadExcept tNew e m
261− => MonadExcept tOld e (DispatchTagReplaceT tOld tNew m) where
262− throw _ = Lift.lift . A.throw @tNew
263− catch _ = Lift.liftCatch (A.catch @tNew)
264−
265−instance MonadWriter tNew w m
266− => MonadWriter tOld w (DispatchTagReplaceT tOld tNew m) where
267− writer _ = Lift.lift . A.writer @tNew
268− tell _ = Lift.lift . A.tell @tNew
269− listen _ = Lift.liftListen (A.listen @tNew)
270− pass _ = Lift.liftPass (A.pass @tNew)
ether/src/Control/Monad/Trans/Ether/Except.hsdeleted−70
@@ -1,70 +0,0 @@
1−{-# LANGUAGE DeriveGeneric #-}
2−{-# LANGUAGE TypeFamilies #-}
3−{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE UndecidableInstances #-}
5−{-# LANGUAGE DataKinds #-}
6−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7−{-# LANGUAGE AllowAmbiguousTypes #-}
8−
9−-- | See "Control.Monad.Trans.Except".
10−
11−module Control.Monad.Trans.Ether.Except
12− (
13− -- * The Except monad
14− Except
15− , except
16− , runExcept
17− -- * The ExceptT monad transformer
18− , ExceptT
19− , exceptT
20− , runExceptT
21− -- * Exception operations
22− , throw
23− , catch
24− ) where
25−
26−import Data.Functor.Identity (Identity(..))
27−import qualified Control.Monad.Trans.Except as Trans
28−import Control.Monad.Trans.Ether.Tagged
29−
30−
31−-- | The parameterizable exception monad.
32−--
33−-- Computations are either exceptions or normal values.
34−--
35−-- The 'return' function returns a normal value, while '>>=' exits on
36−-- the first exception.
37−type Except tag e = ExceptT tag e Identity
38−
39−-- | Runs an 'Except' and returns either an exception or a normal value.
40−runExcept :: forall tag e a . Except tag e a -> Either e a
41−runExcept = Trans.runExcept . unpack
42−
43−-- | The exception monad transformer.
44−--
45−-- The 'return' function returns a normal value, while '>>=' exits on
46−-- the first exception.
47−type ExceptT tag e = TaggedTrans tag (Trans.ExceptT e)
48−
49−-- | Constructor for computations in the exception monad transformer.
50−exceptT :: forall tag e m a . m (Either e a) -> ExceptT tag e m a
51−exceptT = pack . Trans.ExceptT
52−
53−-- | Constructor for computations in the exception monad
54−-- (the inverse of 'runExcept').
55−except :: forall tag e m a . Monad m => Either e a -> ExceptT tag e m a
56−except = exceptT @tag . return
57−
58−-- | Runs an 'ExceptT' and returns either an exception or a normal value.
59−runExceptT :: forall tag e m a . ExceptT tag e m a -> m (Either e a)
60−runExceptT = Trans.runExceptT . unpack
61−
62−-- | Is used within a monadic computation to begin exception processing.
63−throw :: forall tag e m a . Monad m => e -> ExceptT tag e m a
64−throw = pack . Trans.throwE
65−
66−-- | A handler function to handle previous exceptions and return to normal execution.
67−catch
68− :: forall tag e m a . Monad m
69− => ExceptT tag e m a -> (e -> ExceptT tag e m a) -> ExceptT tag e m a
70−catch m h = pack $ Trans.catchE (unpack m) (unpack . h)
ether/src/Control/Monad/Trans/Ether/Reader.hsdeleted−79
@@ -1,79 +0,0 @@
1−{-# LANGUAGE DeriveGeneric #-}
2−{-# LANGUAGE TypeFamilies #-}
3−{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE UndecidableInstances #-}
5−{-# LANGUAGE DataKinds #-}
6−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7−{-# LANGUAGE AllowAmbiguousTypes #-}
8−
9−-- | See "Control.Monad.Trans.Reader".
10−
11−module Control.Monad.Trans.Ether.Reader
12− (
13− -- * The Reader monad
14− Reader
15− , reader
16− , runReader
17− -- * The ReaderT monad transformer
18− , ReaderT
19− , readerT
20− , runReaderT
21− -- * Reader operations
22− , ask
23− , local
24− ) where
25−
26−import Data.Functor.Identity (Identity(..))
27−import qualified Control.Monad.Trans.Reader as Trans
28−import Control.Monad.Trans.Ether.Tagged
29−
30−-- | The parameterizable reader monad.
31−--
32−-- Computations are functions of a shared environment.
33−--
34−-- The 'return' function ignores the environment, while '>>=' passes
35−-- the inherited environment to both subcomputations.
36−type Reader tag r = ReaderT tag r Identity
37−
38−-- | The reader monad transformer,
39−-- which adds a read-only environment to the given monad.
40−--
41−-- The 'return' function ignores the environment, while '>>=' passes
42−-- the inherited environment to both subcomputations.
43−type ReaderT tag r = TaggedTrans tag (Trans.ReaderT r)
44−
45−-- | Constructor for computations in the reader monad transformer.
46−readerT :: forall tag r m a . (r -> m a) -> ReaderT tag r m a
47−readerT = pack . Trans.ReaderT
48−
49−-- | Constructor for computations in the reader monad
50−-- (the inverse of 'runReader').
51−reader :: forall tag r m a . Monad m => (r -> a) -> ReaderT tag r m a
52−reader = pack . Trans.reader
53−
54−-- | Runs a 'ReaderT' with the given environment
55−-- and returns the final value.
56−runReaderT :: forall tag r m a . ReaderT tag r m a -> r -> m a
57−runReaderT = Trans.runReaderT . unpack
58−
59−-- | Runs a 'ReaderT' with the given environment
60−-- and returns the final value.
61−runReader :: forall tag r a . Reader tag r a -> r -> a
62−runReader = Trans.runReader . unpack
63−
64−-- | Fetch the value of the environment.
65−ask :: forall tag r m . Monad m => ReaderT tag r m r
66−ask = pack Trans.ask
67−
68−-- | Execute a computation in a modified environment
69−-- (a specialization of 'withReaderT').
70−--
71−-- * @'runReaderT' tag ('local' tag f m) = 'runReaderT' tag m . f@
72−local
73− :: forall tag r m a
74− . (r -> r)
75− -- ^ The function to modify the environment.
76− -> ReaderT tag r m a
77− -- ^ Computation to run in the modified environment.
78− -> ReaderT tag r m a
79−local f = pack . Trans.withReaderT f . unpack
ether/src/Control/Monad/Trans/Ether/State.hsdeleted−8
@@ -1,8 +0,0 @@
1−
2−-- | See "Control.Monad.Trans.State".
3−
4−module Control.Monad.Trans.Ether.State
5− ( module Control.Monad.Trans.Ether.State.Lazy
6− ) where
7−
8−import Control.Monad.Trans.Ether.State.Lazy
ether/src/Control/Monad/Trans/Ether/State/Lazy.hsdeleted−93
@@ -1,93 +0,0 @@
1−{-# LANGUAGE DeriveGeneric #-}
2−{-# LANGUAGE TypeFamilies #-}
3−{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE UndecidableInstances #-}
5−{-# LANGUAGE DataKinds #-}
6−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7−{-# LANGUAGE AllowAmbiguousTypes #-}
8−
9−-- | See "Control.Monad.Trans.State.Lazy".
10−
11−module Control.Monad.Trans.Ether.State.Lazy
12− (
13− -- * The State monad
14− State
15− , state
16− , runState
17− , evalState
18− , execState
19− -- * The StateT monad transformer
20− , StateT
21− , stateT
22− , runStateT
23− , evalStateT
24− , execStateT
25− -- * State operations
26− , get
27− , put
28− ) where
29−
30−import Data.Functor.Identity (Identity(..))
31−import qualified Control.Monad.Trans.State.Lazy as Trans
32−import Control.Monad.Trans.Ether.Tagged
33−
34−-- | The parametrizable state monad.
35−--
36−-- Computations have access to a mutable state.
37−--
38−-- The 'return' function leaves the state unchanged, while '>>=' uses
39−-- the final state of the first computation as the initial state of the second.
40−type State tag r = StateT tag r Identity
41−
42−-- | The state monad transformer.
43−--
44−-- The 'return' function leaves the state unchanged, while '>>=' uses
45−-- the final state of the first computation as the initial state of the second.
46−type StateT tag s = TaggedTrans tag (Trans.StateT s)
47−
48−-- | Constructor for computations in the state monad transformer.
49−stateT :: forall tag s m a . (s -> m (a, s)) -> StateT tag s m a
50−stateT = pack . Trans.StateT
51−
52−-- | Constructor for computations in the state monad
53−-- (the inverse of 'runState').
54−state :: forall tag s m a . Monad m => (s -> (a, s)) -> StateT tag s m a
55−state = pack . Trans.state
56−
57−-- | Runs a 'StateT' with the given initial state
58−-- and returns both the final value and the final state.
59−runStateT :: forall tag s m a . StateT tag s m a -> s -> m (a, s)
60−runStateT = Trans.runStateT . unpack
61−
62−-- | Runs a 'StateT' with the given initial state
63−-- and returns the final value, discarding the final state.
64−evalStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m a
65−evalStateT = Trans.evalStateT . unpack
66−
67−-- | Runs a 'StateT' with the given initial state
68−-- and returns the final state, discarding the final value.
69−execStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m s
70−execStateT = Trans.execStateT . unpack
71−
72−-- | Runs a 'State' with the given initial state
73−-- and returns both the final value and the final state.
74−runState :: forall tag s a . State tag s a -> s -> (a, s)
75−runState = Trans.runState . unpack
76−
77−-- | Runs a 'State' with the given initial state
78−-- and returns the final value, discarding the final state.
79−evalState :: forall tag s a . State tag s a -> s -> a
80−evalState = Trans.evalState . unpack
81−
82−-- | Runs a 'State' with the given initial state
83−-- and returns the final state, discarding the final value.
84−execState :: forall tag s a . State tag s a -> s -> s
85−execState = Trans.execState . unpack
86−
87−-- | Fetch the current value of the state within the monad.
88−get :: forall tag s m . Monad m => StateT tag s m s
89−get = pack Trans.get
90−
91−-- | Set the value of the state within the monad.
92−put :: forall tag s m . Monad m => s -> StateT tag s m ()
93−put = pack . Trans.put
ether/src/Control/Monad/Trans/Ether/State/Strict.hsdeleted−93
@@ -1,93 +0,0 @@
1−{-# LANGUAGE DeriveGeneric #-}
2−{-# LANGUAGE TypeFamilies #-}
3−{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE UndecidableInstances #-}
5−{-# LANGUAGE DataKinds #-}
6−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7−{-# LANGUAGE AllowAmbiguousTypes #-}
8−
9−-- | See "Control.Monad.Trans.State.Strict".
10−
11−module Control.Monad.Trans.Ether.State.Strict
12− (
13− -- * The State monad
14− State
15− , state
16− , runState
17− , evalState
18− , execState
19− -- * The StateT monad transformer
20− , StateT
21− , stateT
22− , runStateT
23− , evalStateT
24− , execStateT
25− -- * State operations
26− , get
27− , put
28− ) where
29−
30−import Data.Functor.Identity (Identity(..))
31−import qualified Control.Monad.Trans.State.Strict as Trans
32−import Control.Monad.Trans.Ether.Tagged
33−
34−-- | The parametrizable state monad.
35−--
36−-- Computations have access to a mutable state.
37−--
38−-- The 'return' function leaves the state unchanged, while '>>=' uses
39−-- the final state of the first computation as the initial state of the second.
40−type State tag r = StateT tag r Identity
41−
42−-- | The state monad transformer.
43−--
44−-- The 'return' function leaves the state unchanged, while '>>=' uses
45−-- the final state of the first computation as the initial state of the second.
46−type StateT tag s = TaggedTrans tag (Trans.StateT s)
47−
48−-- | Constructor for computations in the state monad transformer.
49−stateT :: forall tag s m a . (s -> m (a, s)) -> StateT tag s m a
50−stateT = pack . Trans.StateT
51−
52−-- | Constructor for computations in the state monad
53−-- (the inverse of 'runState').
54−state :: forall tag s m a . Monad m => (s -> (a, s)) -> StateT tag s m a
55−state = pack . Trans.state
56−
57−-- | Runs a 'StateT' with the given initial state
58−-- and returns both the final value and the final state.
59−runStateT :: forall tag s m a . StateT tag s m a -> s -> m (a, s)
60−runStateT = Trans.runStateT . unpack
61−
62−-- | Runs a 'StateT' with the given initial state
63−-- and returns the final value, discarding the final state.
64−evalStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m a
65−evalStateT = Trans.evalStateT . unpack
66−
67−-- | Runs a 'StateT' with the given initial state
68−-- and returns the final state, discarding the final value.
69−execStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m s
70−execStateT = Trans.execStateT . unpack
71−
72−-- | Runs a 'State' with the given initial state
73−-- and returns both the final value and the final state.
74−runState :: forall tag s a . State tag s a -> s -> (a, s)
75−runState = Trans.runState . unpack
76−
77−-- | Runs a 'State' with the given initial state
78−-- and returns the final value, discarding the final state.
79−evalState :: forall tag s a . State tag s a -> s -> a
80−evalState = Trans.evalState . unpack
81−
82−-- | Runs a 'State' with the given initial state
83−-- and returns the final state, discarding the final value.
84−execState :: forall tag s a . State tag s a -> s -> s
85−execState = Trans.execState . unpack
86−
87−-- | Fetch the current value of the state within the monad.
88−get :: forall tag s m . Monad m => StateT tag s m s
89−get = pack Trans.get
90−
91−-- | Set the value of the state within the monad.
92−put :: forall tag s m . Monad m => s -> StateT tag s m ()
93−put = pack . Trans.put
ether/src/Control/Monad/Trans/Ether/Tagged.hsdeleted−150
@@ -1,150 +0,0 @@
1−{-# LANGUAGE DeriveGeneric #-}
2−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3−{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE UndecidableInstances #-}
5−{-# LANGUAGE ConstraintKinds #-}
6−{-# LANGUAGE TypeFamilies #-}
7−
8−-- | This module defines the core data type of Ether, 'TaggedTrans',
9−-- and a bunch of instances for it. 'TaggedTrans' attaches a tag to
10−-- an existing monad transformer.
11−
12−module Control.Monad.Trans.Ether.Tagged where
13−
14−import Control.Applicative
15−import Control.Monad (MonadPlus)
16−import Control.Monad.Fix (MonadFix)
17−import Control.Monad.Trans.Class (MonadTrans, lift)
18−import Control.Monad.IO.Class (MonadIO)
19−import Control.Monad.Morph (MFunctor, MMonad)
20−import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
21−
22−import qualified Control.Monad.Base as MB
23−import qualified Control.Monad.Trans.Control as MC
24−
25−import qualified Control.Monad.Trans.Lift.StT as Lift
26−import qualified Control.Monad.Trans.Lift.Local as Lift
27−import qualified Control.Monad.Trans.Lift.Catch as Lift
28−import qualified Control.Monad.Trans.Lift.Listen as Lift
29−import qualified Control.Monad.Trans.Lift.Pass as Lift
30−import qualified Control.Monad.Trans.Lift.CallCC as Lift
31−
32−import qualified Control.Monad.Cont.Class as Class
33−import qualified Control.Monad.Reader.Class as Class
34−import qualified Control.Monad.State.Class as Class
35−import qualified Control.Monad.Writer.Class as Class
36−import qualified Control.Monad.Error.Class as Class
37−
38−import GHC.Generics (Generic)
39−import Data.Coerce (coerce)
40−
41−-- | Tagged monad transformer.
42−newtype TaggedTrans tag trans (m :: * -> *) a = TaggedTrans (trans m a)
43− deriving
44− ( Generic
45− , Functor, Applicative, Alternative, Monad, MonadPlus
46− , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad
47− , MonadThrow, MonadCatch, MonadMask )
48−
49−-- | Type-restricted 'coerce'.
50−pack :: trans m a -> TaggedTrans tag trans m a
51−pack = coerce
52−
53−-- | Type-restricted 'coerce'.
54−unpack :: TaggedTrans tag trans m a -> trans m a
55−unpack = coerce
56−
57−instance
58− ( MB.MonadBase b m
59− , MonadTrans trans
60− , Monad (trans m)
61− ) => MB.MonadBase b (TaggedTrans tag trans m)
62− where
63− liftBase = MB.liftBaseDefault
64−
65−instance
66− ( MC.MonadTransControl trans
67− ) => MC.MonadTransControl (TaggedTrans tag trans)
68− where
69− type StT (TaggedTrans tag trans) a = MC.StT trans a
70− liftWith = MC.defaultLiftWith pack unpack
71− restoreT = MC.defaultRestoreT pack
72−
73−instance
74− ( MC.MonadBaseControl b m
75− , MC.MonadTransControl trans
76− , Monad (trans m)
77− ) => MC.MonadBaseControl b (TaggedTrans tag trans m)
78− where
79− type StM (TaggedTrans tag trans m) a = MC.ComposeSt trans m a
80− liftBaseWith = MC.defaultLiftBaseWith
81− restoreM = MC.defaultRestoreM
82−
83−type instance Lift.StT (TaggedTrans tag trans) a = Lift.StT trans a
84−
85−instance Lift.LiftLocal trans => Lift.LiftLocal (TaggedTrans tag trans) where
86− liftLocal = Lift.defaultLiftLocal pack unpack
87−
88−instance Lift.LiftCatch trans => Lift.LiftCatch (TaggedTrans tag trans) where
89− liftCatch = Lift.defaultLiftCatch pack unpack
90−
91−instance Lift.LiftListen trans => Lift.LiftListen (TaggedTrans tag trans) where
92− liftListen = Lift.defaultLiftListen pack unpack
93−
94−instance Lift.LiftPass trans => Lift.LiftPass (TaggedTrans tag trans) where
95− liftPass = Lift.defaultLiftPass pack unpack
96−
97−instance Lift.LiftCallCC trans => Lift.LiftCallCC (TaggedTrans tag trans) where
98− liftCallCC = Lift.defaultLiftCallCC pack unpack
99− liftCallCC' = Lift.defaultLiftCallCC' pack unpack
100−
101−-- Instances for mtl classes
102−
103−instance
104− ( Class.MonadCont m
105− , Lift.LiftCallCC trans
106− , Monad (trans m)
107− ) => Class.MonadCont (TaggedTrans tag trans m)
108− where
109− callCC = Lift.liftCallCC' Class.callCC
110−
111−instance
112− ( Class.MonadReader r m
113− , Lift.LiftLocal trans
114− , Monad (trans m)
115− ) => Class.MonadReader r (TaggedTrans tag trans m)
116− where
117− ask = lift Class.ask
118− local = Lift.liftLocal Class.ask Class.local
119− reader = lift . Class.reader
120−
121−instance
122− ( Class.MonadState s m
123− , MonadTrans trans
124− , Monad (trans m)
125− ) => Class.MonadState s (TaggedTrans tag trans m)
126− where
127− get = lift Class.get
128− put = lift . Class.put
129− state = lift . Class.state
130−
131−instance
132− ( Class.MonadWriter w m
133− , Lift.LiftListen trans
134− , Lift.LiftPass trans
135− , Monad (trans m)
136− ) => Class.MonadWriter w (TaggedTrans tag trans m)
137− where
138− writer = lift . Class.writer
139− tell = lift . Class.tell
140− listen = Lift.liftListen Class.listen
141− pass = Lift.liftPass Class.pass
142−
143−instance
144− ( Class.MonadError e m
145− , Lift.LiftCatch trans
146− , Monad (trans m)
147− ) => Class.MonadError e (TaggedTrans tag trans m)
148− where
149− throwError = lift . Class.throwError
150− catchError = Lift.liftCatch Class.catchError
ether/src/Control/Monad/Trans/Ether/Writer.hsdeleted−87
@@ -1,87 +0,0 @@
1−{-# LANGUAGE DeriveGeneric #-}
2−{-# LANGUAGE TypeFamilies #-}
3−{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE UndecidableInstances #-}
5−{-# LANGUAGE DataKinds #-}
6−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7−{-# LANGUAGE AllowAmbiguousTypes #-}
8−
9−-- | See "Control.Monad.Trans.Writer".
10−
11−module Control.Monad.Trans.Ether.Writer
12− (
13− -- * The Writer monad
14− Writer
15− , writer
16− , runWriter
17− , execWriter
18− -- * The WriterT monad transformer
19− , WriterT
20− , writerT
21− , runWriterT
22− , execWriterT
23− -- * Writer operations
24− , tell
25− , listen
26− , pass
27− ) where
28−
29−import Data.Functor.Identity (Identity(..))
30−import qualified Control.Monad.Trans.Writer.Lazy as Trans
31−import Control.Monad.Trans.Ether.Tagged
32−
33−-- | The parametrizable writer monad.
34−--
35−-- Computations can accumulate a monoid value.
36−--
37−-- The 'return' function produces the output 'mempty', while '>>=' combines
38−-- the outputs of the subcomputations using 'mappend'.
39−type Writer tag w = WriterT tag w Identity
40−
41−-- | The writer monad transformer.
42−--
43−-- The 'return' function produces the output 'mempty', while '>>=' combines
44−-- the outputs of the subcomputations using 'mappend'.
45−type WriterT tag w = TaggedTrans tag (Trans.WriterT w)
46−
47−-- | Constructor for computations in the writer monad transformer.
48−writerT :: forall tag w m a . m (a, w) -> WriterT tag w m a
49−writerT = pack . Trans.WriterT
50−
51−-- | Constructor for computations in the writer monad
52−-- (the inverse of 'runWriter').
53−writer :: forall tag w m a . Monad m => (a, w) -> WriterT tag w m a
54−writer = pack . Trans.writer
55−
56−-- | Runs a 'WriterT' and returns both the normal value
57−-- and the final accumulator.
58−runWriterT :: forall tag w m a . WriterT tag w m a -> m (a, w)
59−runWriterT = Trans.runWriterT . unpack
60−
61−-- | Runs a 'Writer' and returns both the normal value
62−-- and the final accumulator.
63−runWriter :: forall tag w a . Writer tag w a -> (a, w)
64−runWriter = Trans.runWriter . unpack
65−
66−-- | Runs a 'WriterT' and returns the final accumulator,
67−-- discarding the normal value.
68−execWriterT :: forall tag w m a . Monad m => WriterT tag w m a -> m w
69−execWriterT = Trans.execWriterT . unpack
70−
71−-- | Runs a 'Writer' and returns the final accumulator,
72−-- discarding the normal value.
73−execWriter :: forall tag w a . Writer tag w a -> w
74−execWriter = Trans.execWriter . unpack
75−
76−-- | Appends a value to the accumulator within the monad.
77−tell :: forall tag w m . Monad m => w -> WriterT tag w m ()
78−tell w = writer @tag ((), w)
79−
80−-- | Executes an action and adds its accumulator to the value of the computation.
81−listen :: forall tag w m a . Monad m => WriterT tag w m a -> WriterT tag w m (a, w)
82−listen = pack . Trans.listen . unpack
83−
84−-- | Executes an action which returns a value and a function, and returns the
85−-- value, applying the function to the accumulator.
86−pass :: forall tag w m a . Monad m => WriterT tag w m (a, w -> w) -> WriterT tag w m a
87−pass = pack . Trans.pass . unpack