git.iko.soy/typeable/ether
on master help sign in
Use defaultLiftWith and defaultRestoreT
04eb4c1Index Int
ether.cabal+1−1
compare with master
unifiedsplit
@@ -58,7 +58,7 @@ library
58
58
59 build-depends: base >=4.7 && <4.9
59 build-depends: base >=4.7 && <4.9
60 , transformers >=0.4.2
60 , transformers >=0.4.2
61− , transformers-lift >=0.1
61+ , transformers-lift >=0.0
62 , mtl >=2.2.1
62 , mtl >=2.2.1
63 , mmorph >=1.0.4
63 , mmorph >=1.0.4
64 , monad-control >=1.0.0.4
64 , monad-control >=1.0.0.4
src/Control/Monad/Trans/Ether/Except.hs+9−12
@@ -24,7 +24,6 @@ module Control.Monad.Trans.Ether.Except
24 ) where
24 ) where
25
25
26import Data.Functor.Identity (Identity(..))
26import Data.Functor.Identity (Identity(..))
27−import Data.Coerce (coerce)
28import Control.Applicative
27import Control.Applicative
29import Control.Monad (MonadPlus)
28import Control.Monad (MonadPlus)
30import Control.Monad.Fix (MonadFix)
29import Control.Monad.Fix (MonadFix)
@@ -68,7 +67,7 @@ runExcept t = Trans.runExcept . untagged t
68-- The 'return' function returns a normal value, while '>>=' exits on
67-- The 'return' function returns a normal value, while '>>=' exits on
69-- the first exception.
68-- the first exception.
70
69
71−newtype ExceptT tag e m a = ExceptT (Trans.ExceptT e m a)
70+newtype ExceptT tag e m a = ET { runET :: Trans.ExceptT e m a }
72 deriving ( Generic
71 deriving ( Generic
73 , Functor, Applicative, Alternative, Monad, MonadPlus
72 , Functor, Applicative, Alternative, Monad, MonadPlus
74 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
73 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
@@ -77,20 +76,18 @@ instance NT.Newtype (ExceptT tag e m a)
77
76
78instance MC.MonadTransControl (ExceptT tag e) where
77instance MC.MonadTransControl (ExceptT tag e) where
79 type StT (ExceptT tag e) a = MC.StT (Trans.ExceptT e) a
78 type StT (ExceptT tag e) a = MC.StT (Trans.ExceptT e) a
80− liftWith f = ExceptT $ MC.liftWith (f . coerce)
79+ liftWith = MC.defaultLiftWith ET runET
81− restoreT = ExceptT . MC.restoreT
80+ restoreT = MC.defaultRestoreT ET
82
81
83−instance Lift.LiftLocal (ExceptT tag e)
82+instance Lift.LiftLocal (ExceptT tag e)
84−instance Lift.LiftCatch (ExceptT tag e)
83+instance Lift.LiftCatch (ExceptT tag e)
85−
86−instance Lift.LiftListen (ExceptT tag e) where
84+instance Lift.LiftListen (ExceptT tag e)
87− liftListen listen m = ExceptT $ Lift.liftListen listen (coerce m)
88
85
89instance Lift.LiftPass (ExceptT tag e) where
86instance Lift.LiftPass (ExceptT tag e) where
90− liftPass pass m = ExceptT $ Lift.liftPass pass (coerce m)
87+ liftPass pass m = ET $ Lift.liftPass pass (runET m)
91
88
92instance Lift.LiftCallCC (ExceptT tag e) where
89instance Lift.LiftCallCC (ExceptT tag e) where
93− liftCallCC callCC f = ExceptT $ Lift.liftCallCC callCC (coerce f)
90+ liftCallCC callCC f = ET $ Lift.liftCallCC callCC (\g -> (runET . f) (ET . g))
94
91
95instance Taggable (ExceptT tag e m) where
92instance Taggable (ExceptT tag e m) where
96 type Tag (ExceptT tag e m) = 'Just tag
93 type Tag (ExceptT tag e m) = 'Just tag
@@ -118,7 +115,7 @@ throw t = tagged t . Trans.throwE
118
115
119-- | A handler function to handle previous exceptions and return to normal execution.
116-- | A handler function to handle previous exceptions and return to normal execution.
120catch :: Monad m => proxy tag -> ExceptT tag e m a -> (e -> ExceptT tag e m a) -> ExceptT tag e m a
117catch :: Monad m => proxy tag -> ExceptT tag e m a -> (e -> ExceptT tag e m a) -> ExceptT tag e m a
121−catch t m h = tagged t $ Trans.catchE (coerce m) (coerce . h)
118+catch t m h = tagged t $ Trans.catchE (untagged t m) (untagged t . h)
122
119
123instance Class.MonadCont m => Class.MonadCont (ExceptT tag e m) where
120instance Class.MonadCont m => Class.MonadCont (ExceptT tag e m) where
124 callCC = Lift.liftCallCC Class.callCC
121 callCC = Lift.liftCallCC Class.callCC
src/Control/Monad/Trans/Ether/Reader.hs+7−10
@@ -24,7 +24,6 @@ module Control.Monad.Trans.Ether.Reader
24 ) where
24 ) where
25
25
26import Data.Functor.Identity (Identity(..))
26import Data.Functor.Identity (Identity(..))
27−import Data.Coerce (coerce)
28import Control.Applicative
27import Control.Applicative
29import Control.Monad (MonadPlus)
28import Control.Monad (MonadPlus)
30import Control.Monad.Fix (MonadFix)
29import Control.Monad.Fix (MonadFix)
@@ -63,7 +62,7 @@ type Reader tag r = ReaderT tag r Identity
63--
62--
64-- The 'return' function ignores the environment, while '>>=' passes
63-- The 'return' function ignores the environment, while '>>=' passes
65-- the inherited environment to both subcomputations.
64-- the inherited environment to both subcomputations.
66−newtype ReaderT tag r m a = ReaderT (Trans.ReaderT r m a)
65+newtype ReaderT tag r m a = RT { runRT :: Trans.ReaderT r m a }
67 deriving ( Generic
66 deriving ( Generic
68 , Functor, Applicative, Alternative, Monad, MonadPlus
67 , Functor, Applicative, Alternative, Monad, MonadPlus
69 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
68 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
@@ -72,20 +71,18 @@ instance NT.Newtype (ReaderT tag r m a)
72
71
73instance MC.MonadTransControl (ReaderT tag r) where
72instance MC.MonadTransControl (ReaderT tag r) where
74 type StT (ReaderT tag r) a = MC.StT (Trans.ReaderT r) a
73 type StT (ReaderT tag r) a = MC.StT (Trans.ReaderT r) a
75− liftWith f = ReaderT $ MC.liftWith (f . coerce)
74+ liftWith = MC.defaultLiftWith RT runRT
76− restoreT = ReaderT . MC.restoreT
75+ restoreT = MC.defaultRestoreT RT
77
76
78instance Lift.LiftLocal (ReaderT tag r)
77instance Lift.LiftLocal (ReaderT tag r)
79instance Lift.LiftCatch (ReaderT tag r)
78instance Lift.LiftCatch (ReaderT tag r)
80−
81−instance Lift.LiftListen (ReaderT tag r) where
79+instance Lift.LiftListen (ReaderT tag r)
82− liftListen listen m = ReaderT $ Lift.liftListen listen (coerce m)
83
80
84instance Lift.LiftPass (ReaderT tag r) where
81instance Lift.LiftPass (ReaderT tag r) where
85− liftPass pass m = ReaderT $ Lift.liftPass pass (coerce m)
82+ liftPass pass m = RT $ Lift.liftPass pass (runRT m)
86
83
87instance Lift.LiftCallCC (ReaderT tag r) where
84instance Lift.LiftCallCC (ReaderT tag r) where
88− liftCallCC callCC f = ReaderT $ Lift.liftCallCC callCC (coerce f)
85+ liftCallCC callCC f = RT $ Lift.liftCallCC callCC (\g -> (runRT . f) (RT . g))
89
86
90instance Taggable (ReaderT tag r m) where
87instance Taggable (ReaderT tag r m) where
91 type Tag (ReaderT tag r m) = 'Just tag
88 type Tag (ReaderT tag r m) = 'Just tag
@@ -128,7 +125,7 @@ local
128 -> ReaderT tag r m a
125 -> ReaderT tag r m a
129 -- ^ Computation to run in the modified environment.
126 -- ^ Computation to run in the modified environment.
130 -> ReaderT tag r m a
127 -> ReaderT tag r m a
131−local t f m = tagged t $ Trans.withReaderT f (coerce m)
128+local t f m = tagged t $ Trans.withReaderT f (untagged t m)
132
129
133-- Instances for mtl classes
130-- Instances for mtl classes
134
131
src/Control/Monad/Trans/Ether/State/Lazy.hs+9−12
@@ -28,7 +28,6 @@ module Control.Monad.Trans.Ether.State.Lazy
28 ) where
28 ) where
29
29
30import Data.Functor.Identity (Identity(..))
30import Data.Functor.Identity (Identity(..))
31−import Data.Coerce (coerce)
32import Control.Applicative
31import Control.Applicative
33import Control.Monad (MonadPlus)
32import Control.Monad (MonadPlus)
34import Control.Monad.Fix (MonadFix)
33import Control.Monad.Fix (MonadFix)
@@ -67,7 +66,7 @@ type State tag r = StateT tag r Identity
67--
66--
68-- The 'return' function leaves the state unchanged, while '>>=' uses
67-- The 'return' function leaves the state unchanged, while '>>=' uses
69-- the final state of the first computation as the initial state of the second.
68-- the final state of the first computation as the initial state of the second.
70−newtype StateT tag s m a = StateT (Trans.StateT s m a)
69+newtype StateT tag s m a = ST { runST :: Trans.StateT s m a }
71 deriving ( Generic
70 deriving ( Generic
72 , Functor, Applicative, Alternative, Monad, MonadPlus
71 , Functor, Applicative, Alternative, Monad, MonadPlus
73 , MonadFix, MonadTrans, MonadIO, MFunctor )
72 , MonadFix, MonadTrans, MonadIO, MFunctor )
@@ -76,21 +75,19 @@ instance NT.Newtype (StateT tag s m a)
76
75
77instance MC.MonadTransControl (StateT tag s) where
76instance MC.MonadTransControl (StateT tag s) where
78 type StT (StateT tag s) a = MC.StT (Trans.StateT s) a
77 type StT (StateT tag s) a = MC.StT (Trans.StateT s) a
79− liftWith f = StateT $ MC.liftWith (f . coerce)
78+ liftWith = MC.defaultLiftWith ST runST
80− restoreT = StateT . MC.restoreT
79+ restoreT = MC.defaultRestoreT ST
81
80
82−instance Lift.LiftLocal (StateT tag s)
81+instance Lift.LiftLocal (StateT tag s)
83−instance Lift.LiftCatch (StateT tag s)
82+instance Lift.LiftCatch (StateT tag s)
84−
85−instance Lift.LiftListen (StateT tag s) where
83+instance Lift.LiftListen (StateT tag s)
86− liftListen listen m = StateT $ Lift.liftListen listen (coerce m)
87
84
88instance Lift.LiftPass (StateT tag s) where
85instance Lift.LiftPass (StateT tag s) where
89− liftPass pass m = StateT $ Lift.liftPass pass (coerce m)
86+ liftPass pass m = ST $ Lift.liftPass pass (runST m)
90
87
91instance Lift.LiftCallCC (StateT tag s) where
88instance Lift.LiftCallCC (StateT tag s) where
92− liftCallCC callCC f = StateT $ Lift.liftCallCC callCC (coerce f)
89+ liftCallCC callCC f = ST $ Lift.liftCallCC callCC (\g -> (runST . f) (ST . g))
93− liftCallCC' callCC f = StateT $ Lift.liftCallCC' callCC (coerce f)
90+ liftCallCC' callCC f = ST $ Lift.liftCallCC' callCC (\g -> (runST . f) (ST . g))
94
91
95instance Taggable (StateT tag s m) where
92instance Taggable (StateT tag s m) where
96 type Tag (StateT tag s m) = 'Just tag
93 type Tag (StateT tag s m) = 'Just tag
src/Control/Monad/Trans/Ether/State/Strict.hs+9−12
@@ -28,7 +28,6 @@ module Control.Monad.Trans.Ether.State.Strict
28 ) where
28 ) where
29
29
30import Data.Functor.Identity (Identity(..))
30import Data.Functor.Identity (Identity(..))
31−import Data.Coerce (coerce)
32import Control.Applicative
31import Control.Applicative
33import Control.Monad (MonadPlus)
32import Control.Monad (MonadPlus)
34import Control.Monad.Fix (MonadFix)
33import Control.Monad.Fix (MonadFix)
@@ -67,7 +66,7 @@ type State tag r = StateT tag r Identity
67--
66--
68-- The 'return' function leaves the state unchanged, while '>>=' uses
67-- The 'return' function leaves the state unchanged, while '>>=' uses
69-- the final state of the first computation as the initial state of the second.
68-- the final state of the first computation as the initial state of the second.
70−newtype StateT tag s m a = StateT (Trans.StateT s m a)
69+newtype StateT tag s m a = ST { runST :: Trans.StateT s m a }
71 deriving ( Generic
70 deriving ( Generic
72 , Functor, Applicative, Alternative, Monad, MonadPlus
71 , Functor, Applicative, Alternative, Monad, MonadPlus
73 , MonadFix, MonadTrans, MonadIO, MFunctor )
72 , MonadFix, MonadTrans, MonadIO, MFunctor )
@@ -76,21 +75,19 @@ instance NT.Newtype (StateT tag s m a)
76
75
77instance MC.MonadTransControl (StateT tag s) where
76instance MC.MonadTransControl (StateT tag s) where
78 type StT (StateT tag s) a = MC.StT (Trans.StateT s) a
77 type StT (StateT tag s) a = MC.StT (Trans.StateT s) a
79− liftWith f = StateT $ MC.liftWith (f . coerce)
78+ liftWith = MC.defaultLiftWith ST runST
80− restoreT = StateT . MC.restoreT
79+ restoreT = MC.defaultRestoreT ST
81
80
82−instance Lift.LiftLocal (StateT tag s)
81+instance Lift.LiftLocal (StateT tag s)
83−instance Lift.LiftCatch (StateT tag s)
82+instance Lift.LiftCatch (StateT tag s)
84−
85−instance Lift.LiftListen (StateT tag s) where
83+instance Lift.LiftListen (StateT tag s)
86− liftListen listen m = StateT $ Lift.liftListen listen (coerce m)
87
84
88instance Lift.LiftPass (StateT tag s) where
85instance Lift.LiftPass (StateT tag s) where
89− liftPass pass m = StateT $ Lift.liftPass pass (coerce m)
86+ liftPass pass m = ST $ Lift.liftPass pass (runST m)
90
87
91instance Lift.LiftCallCC (StateT tag s) where
88instance Lift.LiftCallCC (StateT tag s) where
92− liftCallCC callCC f = StateT $ Lift.liftCallCC callCC (coerce f)
89+ liftCallCC callCC f = ST $ Lift.liftCallCC callCC (\g -> (runST . f) (ST . g))
93− liftCallCC' callCC f = StateT $ Lift.liftCallCC' callCC (coerce f)
90+ liftCallCC' callCC f = ST $ Lift.liftCallCC' callCC (\g -> (runST . f) (ST . g))
94
91
95instance Taggable (StateT tag s m) where
92instance Taggable (StateT tag s m) where
96 type Tag (StateT tag s m) = 'Just tag
93 type Tag (StateT tag s m) = 'Just tag
src/Control/Monad/Trans/Ether/Writer.hs+10−13
@@ -32,7 +32,6 @@ import Data.Monoid
32#endif
32#endif
33
33
34import Data.Functor.Identity (Identity(..))
34import Data.Functor.Identity (Identity(..))
35−import Data.Coerce (coerce)
36import Control.Applicative
35import Control.Applicative
37import Control.Monad (MonadPlus)
36import Control.Monad (MonadPlus)
38import Control.Monad.Fix (MonadFix)
37import Control.Monad.Fix (MonadFix)
@@ -70,7 +69,7 @@ type Writer tag w = WriterT tag w Identity
70--
69--
71-- The 'return' function produces the output 'mempty', while '>>=' combines
70-- The 'return' function produces the output 'mempty', while '>>=' combines
72-- the outputs of the subcomputations using 'mappend'.
71-- the outputs of the subcomputations using 'mappend'.
73−newtype WriterT tag w m a = WriterT (Trans.WriterT w m a)
72+newtype WriterT tag w m a = WT { runWT :: Trans.WriterT w m a }
74 deriving ( Generic
73 deriving ( Generic
75 , Functor, Applicative, Alternative, Monad, MonadPlus
74 , Functor, Applicative, Alternative, Monad, MonadPlus
76 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
75 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
@@ -79,20 +78,18 @@ instance NT.Newtype (WriterT tag w m a)
79
78
80instance Monoid w => MC.MonadTransControl (WriterT tag w) where
79instance Monoid w => MC.MonadTransControl (WriterT tag w) where
81 type StT (WriterT tag w) a = MC.StT (Trans.WriterT w) a
80 type StT (WriterT tag w) a = MC.StT (Trans.WriterT w) a
82− liftWith f = WriterT $ MC.liftWith (f . coerce)
81+ liftWith = MC.defaultLiftWith WT runWT
83− restoreT = WriterT . MC.restoreT
82+ restoreT = MC.defaultRestoreT WT
84
83
85−instance Monoid w => Lift.LiftLocal (WriterT tag w)
84+instance Monoid w => Lift.LiftLocal (WriterT tag w)
86−instance Monoid w => Lift.LiftCatch (WriterT tag w)
85+instance Monoid w => Lift.LiftCatch (WriterT tag w)
87−
88−instance Monoid w' => Lift.LiftListen (WriterT tag w') where
86+instance Monoid w => Lift.LiftListen (WriterT tag w)
89− liftListen listen' m = WriterT $ Lift.liftListen listen' (coerce m)
90
87
91instance Monoid w' => Lift.LiftPass (WriterT tag w') where
88instance Monoid w' => Lift.LiftPass (WriterT tag w') where
92− liftPass pass' m = WriterT $ Lift.liftPass pass' (coerce m)
89+ liftPass pass' m = WT $ Lift.liftPass pass' (runWT m)
93
90
94instance Monoid w => Lift.LiftCallCC (WriterT tag w) where
91instance Monoid w => Lift.LiftCallCC (WriterT tag w) where
95− liftCallCC callCC f = WriterT $ Lift.liftCallCC callCC (coerce f)
92+ liftCallCC callCC f = WT $ Lift.liftCallCC callCC (\g -> (runWT . f) (WT . g))
96
93
97instance Taggable (WriterT tag w m) where
94instance Taggable (WriterT tag w m) where
98 type Tag (WriterT tag w m) = 'Just tag
95 type Tag (WriterT tag w m) = 'Just tag
@@ -136,12 +133,12 @@ tell t w = writer t ((), w)
136
133
137-- | Executes an action and adds its accumulator to the value of the computation.
134-- | Executes an action and adds its accumulator to the value of the computation.
138listen :: (Monoid w, Monad m) => proxy tag -> WriterT tag w m a -> WriterT tag w m (a, w)
135listen :: (Monoid w, Monad m) => proxy tag -> WriterT tag w m a -> WriterT tag w m (a, w)
139−listen t m = tagged t $ Trans.listen (coerce m)
136+listen t m = tagged t $ Trans.listen (untagged t m)
140
137
141-- | Executes an action which returns a value and a function, and returns the
138-- | Executes an action which returns a value and a function, and returns the
142-- value, applying the function to the accumulator.
139-- value, applying the function to the accumulator.
143pass :: (Monoid w, Monad m) => proxy tag -> WriterT tag w m (a, w -> w) -> WriterT tag w m a
140pass :: (Monoid w, Monad m) => proxy tag -> WriterT tag w m (a, w -> w) -> WriterT tag w m a
144−pass t m = tagged t $ Trans.pass (coerce m)
141+pass t m = tagged t $ Trans.pass (untagged t m)
145
142
146instance (Monoid w, Class.MonadCont m) => Class.MonadCont (WriterT tag w m) where
143instance (Monoid w, Class.MonadCont m) => Class.MonadCont (WriterT tag w m) where
147 callCC = Lift.liftCallCC Class.callCC
144 callCC = Lift.liftCallCC Class.callCC