git.iko.soy/typeable/ether
on master help sign in
Use defaultLiftWith and defaultRestoreT
commit04eb4c19ca2a1a2b1fdefb666819528af7811ab9 authorIndex Int <vlad.z.4096@gmail.com> dateSun 21 Jun 2015, 20:14 (11 years ago) parentd1a6274
6 files changed+45−60
compare with master
unifiedsplit
ether.cabal+1−1 src/Control/Monad/Trans/Ether/Except.hs+9−12 src/Control/Monad/Trans/Ether/Reader.hs+7−10 src/Control/Monad/Trans/Ether/State/Lazy.hs+9−12 src/Control/Monad/Trans/Ether/State/Strict.hs+9−12 src/Control/Monad/Trans/Ether/Writer.hs+10−13
ether.cabal+1−1
@@ -58,7 +58,7 @@ library
5858
5959 build-depends: base >=4.7 && <4.9
6060 , transformers >=0.4.2
61− , transformers-lift >=0.1
61+ , transformers-lift >=0.0
6262 , mtl >=2.2.1
6363 , mmorph >=1.0.4
6464 , 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
2424 ) where
2525
2626import Data.Functor.Identity (Identity(..))
27−import Data.Coerce (coerce)
2827import Control.Applicative
2928import Control.Monad (MonadPlus)
3029import Control.Monad.Fix (MonadFix)
@@ -68,7 +67,7 @@ runExcept t = Trans.runExcept . untagged t
6867-- The 'return' function returns a normal value, while '>>=' exits on
6968-- the first exception.
7069
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 }
7271 deriving ( Generic
7372 , Functor, Applicative, Alternative, Monad, MonadPlus
7473 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
@@ -77,20 +76,18 @@ instance NT.Newtype (ExceptT tag e m a)
7776
7877instance MC.MonadTransControl (ExceptT tag e) where
7978 type StT (ExceptT tag e) a = MC.StT (Trans.ExceptT e) a
80− liftWith f = ExceptT $ MC.liftWith (f . coerce)
81− restoreT = ExceptT . MC.restoreT
79+ liftWith = MC.defaultLiftWith ET runET
80+ restoreT = MC.defaultRestoreT ET
8281
83−instance Lift.LiftLocal (ExceptT tag e)
84−instance Lift.LiftCatch (ExceptT tag e)
85−
86−instance Lift.LiftListen (ExceptT tag e) where
87− liftListen listen m = ExceptT $ Lift.liftListen listen (coerce m)
82+instance Lift.LiftLocal (ExceptT tag e)
83+instance Lift.LiftCatch (ExceptT tag e)
84+instance Lift.LiftListen (ExceptT tag e)
8885
8986instance 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)
9188
9289instance 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))
9491
9592instance Taggable (ExceptT tag e m) where
9693 type Tag (ExceptT tag e m) = 'Just tag
@@ -118,7 +115,7 @@ throw t = tagged t . Trans.throwE
118115
119116-- | A handler function to handle previous exceptions and return to normal execution.
120117catch :: 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)
122119
123120instance Class.MonadCont m => Class.MonadCont (ExceptT tag e m) where
124121 callCC = Lift.liftCallCC Class.callCC
src/Control/Monad/Trans/Ether/Reader.hs+7−10
@@ -24,7 +24,6 @@ module Control.Monad.Trans.Ether.Reader
2424 ) where
2525
2626import Data.Functor.Identity (Identity(..))
27−import Data.Coerce (coerce)
2827import Control.Applicative
2928import Control.Monad (MonadPlus)
3029import Control.Monad.Fix (MonadFix)
@@ -63,7 +62,7 @@ type Reader tag r = ReaderT tag r Identity
6362--
6463-- The 'return' function ignores the environment, while '>>=' passes
6564-- 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 }
6766 deriving ( Generic
6867 , Functor, Applicative, Alternative, Monad, MonadPlus
6968 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
@@ -72,20 +71,18 @@ instance NT.Newtype (ReaderT tag r m a)
7271
7372instance MC.MonadTransControl (ReaderT tag r) where
7473 type StT (ReaderT tag r) a = MC.StT (Trans.ReaderT r) a
75− liftWith f = ReaderT $ MC.liftWith (f . coerce)
76− restoreT = ReaderT . MC.restoreT
74+ liftWith = MC.defaultLiftWith RT runRT
75+ restoreT = MC.defaultRestoreT RT
7776
7877instance Lift.LiftLocal (ReaderT tag r)
7978instance Lift.LiftCatch (ReaderT tag r)
80−
81−instance Lift.LiftListen (ReaderT tag r) where
82− liftListen listen m = ReaderT $ Lift.liftListen listen (coerce m)
79+instance Lift.LiftListen (ReaderT tag r)
8380
8481instance 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)
8683
8784instance 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))
8986
9087instance Taggable (ReaderT tag r m) where
9188 type Tag (ReaderT tag r m) = 'Just tag
@@ -128,7 +125,7 @@ local
128125 -> ReaderT tag r m a
129126 -- ^ Computation to run in the modified environment.
130127 -> 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)
132129
133130-- Instances for mtl classes
134131
src/Control/Monad/Trans/Ether/State/Lazy.hs+9−12
@@ -28,7 +28,6 @@ module Control.Monad.Trans.Ether.State.Lazy
2828 ) where
2929
3030import Data.Functor.Identity (Identity(..))
31−import Data.Coerce (coerce)
3231import Control.Applicative
3332import Control.Monad (MonadPlus)
3433import Control.Monad.Fix (MonadFix)
@@ -67,7 +66,7 @@ type State tag r = StateT tag r Identity
6766--
6867-- The 'return' function leaves the state unchanged, while '>>=' uses
6968-- 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 }
7170 deriving ( Generic
7271 , Functor, Applicative, Alternative, Monad, MonadPlus
7372 , MonadFix, MonadTrans, MonadIO, MFunctor )
@@ -76,21 +75,19 @@ instance NT.Newtype (StateT tag s m a)
7675
7776instance MC.MonadTransControl (StateT tag s) where
7877 type StT (StateT tag s) a = MC.StT (Trans.StateT s) a
79− liftWith f = StateT $ MC.liftWith (f . coerce)
80− restoreT = StateT . MC.restoreT
78+ liftWith = MC.defaultLiftWith ST runST
79+ restoreT = MC.defaultRestoreT ST
8180
82−instance Lift.LiftLocal (StateT tag s)
83−instance Lift.LiftCatch (StateT tag s)
84−
85−instance Lift.LiftListen (StateT tag s) where
86− liftListen listen m = StateT $ Lift.liftListen listen (coerce m)
81+instance Lift.LiftLocal (StateT tag s)
82+instance Lift.LiftCatch (StateT tag s)
83+instance Lift.LiftListen (StateT tag s)
8784
8885instance 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)
9087
9188instance Lift.LiftCallCC (StateT tag s) where
92− liftCallCC callCC f = StateT $ Lift.liftCallCC callCC (coerce f)
93− liftCallCC' callCC f = StateT $ Lift.liftCallCC' callCC (coerce f)
89+ liftCallCC callCC f = ST $ Lift.liftCallCC callCC (\g -> (runST . f) (ST . g))
90+ liftCallCC' callCC f = ST $ Lift.liftCallCC' callCC (\g -> (runST . f) (ST . g))
9491
9592instance Taggable (StateT tag s m) where
9693 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
2828 ) where
2929
3030import Data.Functor.Identity (Identity(..))
31−import Data.Coerce (coerce)
3231import Control.Applicative
3332import Control.Monad (MonadPlus)
3433import Control.Monad.Fix (MonadFix)
@@ -67,7 +66,7 @@ type State tag r = StateT tag r Identity
6766--
6867-- The 'return' function leaves the state unchanged, while '>>=' uses
6968-- 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 }
7170 deriving ( Generic
7271 , Functor, Applicative, Alternative, Monad, MonadPlus
7372 , MonadFix, MonadTrans, MonadIO, MFunctor )
@@ -76,21 +75,19 @@ instance NT.Newtype (StateT tag s m a)
7675
7776instance MC.MonadTransControl (StateT tag s) where
7877 type StT (StateT tag s) a = MC.StT (Trans.StateT s) a
79− liftWith f = StateT $ MC.liftWith (f . coerce)
80− restoreT = StateT . MC.restoreT
78+ liftWith = MC.defaultLiftWith ST runST
79+ restoreT = MC.defaultRestoreT ST
8180
82−instance Lift.LiftLocal (StateT tag s)
83−instance Lift.LiftCatch (StateT tag s)
84−
85−instance Lift.LiftListen (StateT tag s) where
86− liftListen listen m = StateT $ Lift.liftListen listen (coerce m)
81+instance Lift.LiftLocal (StateT tag s)
82+instance Lift.LiftCatch (StateT tag s)
83+instance Lift.LiftListen (StateT tag s)
8784
8885instance 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)
9087
9188instance Lift.LiftCallCC (StateT tag s) where
92− liftCallCC callCC f = StateT $ Lift.liftCallCC callCC (coerce f)
93− liftCallCC' callCC f = StateT $ Lift.liftCallCC' callCC (coerce f)
89+ liftCallCC callCC f = ST $ Lift.liftCallCC callCC (\g -> (runST . f) (ST . g))
90+ liftCallCC' callCC f = ST $ Lift.liftCallCC' callCC (\g -> (runST . f) (ST . g))
9491
9592instance Taggable (StateT tag s m) where
9693 type Tag (StateT tag s m) = 'Just tag
src/Control/Monad/Trans/Ether/Writer.hs+10−13
@@ -32,7 +32,6 @@ import Data.Monoid
3232#endif
3333
3434import Data.Functor.Identity (Identity(..))
35−import Data.Coerce (coerce)
3635import Control.Applicative
3736import Control.Monad (MonadPlus)
3837import Control.Monad.Fix (MonadFix)
@@ -70,7 +69,7 @@ type Writer tag w = WriterT tag w Identity
7069--
7170-- The 'return' function produces the output 'mempty', while '>>=' combines
7271-- 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 }
7473 deriving ( Generic
7574 , Functor, Applicative, Alternative, Monad, MonadPlus
7675 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
@@ -79,20 +78,18 @@ instance NT.Newtype (WriterT tag w m a)
7978
8079instance Monoid w => MC.MonadTransControl (WriterT tag w) where
8180 type StT (WriterT tag w) a = MC.StT (Trans.WriterT w) a
82− liftWith f = WriterT $ MC.liftWith (f . coerce)
83− restoreT = WriterT . MC.restoreT
81+ liftWith = MC.defaultLiftWith WT runWT
82+ restoreT = MC.defaultRestoreT WT
8483
85−instance Monoid w => Lift.LiftLocal (WriterT tag w)
86−instance Monoid w => Lift.LiftCatch (WriterT tag w)
87−
88−instance Monoid w' => Lift.LiftListen (WriterT tag w') where
89− liftListen listen' m = WriterT $ Lift.liftListen listen' (coerce m)
84+instance Monoid w => Lift.LiftLocal (WriterT tag w)
85+instance Monoid w => Lift.LiftCatch (WriterT tag w)
86+instance Monoid w => Lift.LiftListen (WriterT tag w)
9087
9188instance 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)
9390
9491instance 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))
9693
9794instance Taggable (WriterT tag w m) where
9895 type Tag (WriterT tag w m) = 'Just tag
@@ -136,12 +133,12 @@ tell t w = writer t ((), w)
136133
137134-- | Executes an action and adds its accumulator to the value of the computation.
138135listen :: (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)
140137
141138-- | Executes an action which returns a value and a function, and returns the
142139-- value, applying the function to the accumulator.
143140pass :: (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)
145142
146143instance (Monoid w, Class.MonadCont m) => Class.MonadCont (WriterT tag w m) where
147144 callCC = Lift.liftCallCC Class.callCC