git.iko.soy/typeable/ether
on master help sign in
Explicit liftLocal
commite0731a7c7e991ae73397b361a3da423780a8a206 authorIndex Int <vlad.z.4096@gmail.com> dateSat 11 Jul 2015, 19:21 (11 years ago) parent22b765b
5 files changed+85−43
compare with master
unifiedsplit
src/Control/Monad/Trans/Ether/Except.hs+17−9 src/Control/Monad/Trans/Ether/Reader.hs+17−8 src/Control/Monad/Trans/Ether/State/Lazy.hs+17−9 src/Control/Monad/Trans/Ether/State/Strict.hs+17−9 src/Control/Monad/Trans/Ether/Writer.hs+17−8
src/Control/Monad/Trans/Ether/Except.hs+17−9
@@ -37,6 +37,7 @@ import qualified Control.Newtype as NT
3737import qualified Control.Monad.Trans.Control as MC
3838import qualified Control.Monad.Trans.Except as Trans
3939
40+import qualified Control.Monad.Trans.Lift.StT as Lift
4041import qualified Control.Monad.Trans.Lift.Local as Lift
4142import qualified Control.Monad.Trans.Lift.Catch as Lift
4243import qualified Control.Monad.Trans.Lift.Listen as Lift
@@ -66,8 +67,7 @@ runExcept t = Trans.runExcept . untagged t
6667--
6768-- The 'return' function returns a normal value, while '>>=' exits on
6869-- the first exception.
69−
70−newtype ExceptT tag e m a = ET { runET :: Trans.ExceptT e m a }
70+newtype ExceptT tag e m a = ExceptT (Trans.ExceptT e m a)
7171 deriving ( Generic
7272 , Functor, Applicative, Alternative, Monad, MonadPlus
7373 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
@@ -76,18 +76,26 @@ instance NT.Newtype (ExceptT tag e m a)
7676
7777instance MC.MonadTransControl (ExceptT tag e) where
7878 type StT (ExceptT tag e) a = MC.StT (Trans.ExceptT e) a
79− liftWith = MC.defaultLiftWith ET runET
80− restoreT = MC.defaultRestoreT ET
79+ liftWith = MC.defaultLiftWith NT.pack NT.unpack
80+ restoreT = MC.defaultRestoreT NT.pack
81+
82+type instance Lift.StT (ExceptT tag e) a = MC.StT (ExceptT tag e) a
83+
84+instance Lift.LiftLocal (ExceptT tag e) where
85+ liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack
86+
87+instance Lift.LiftCatch (ExceptT tag e) where
88+ liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack
8189
82−instance Lift.LiftLocal (ExceptT tag e)
83−instance Lift.LiftCatch (ExceptT tag e)
84−instance Lift.LiftListen (ExceptT tag e)
90+instance Lift.LiftListen (ExceptT tag e) where
91+ liftListen = Lift.defaultLiftListen NT.pack NT.unpack
8592
8693instance Lift.LiftPass (ExceptT tag e) where
87− liftPass pass m = ET $ Lift.liftPass pass (runET m)
94+ liftPass = Lift.defaultLiftPass NT.pack NT.unpack
8895
8996instance Lift.LiftCallCC (ExceptT tag e) where
90− liftCallCC callCC f = ET $ Lift.liftCallCC callCC (\g -> (runET . f) (ET . g))
97+ liftCallCC = Lift.defaultLiftCallCC NT.pack NT.unpack
98+ liftCallCC' = Lift.defaultLiftCallCC NT.pack NT.unpack
9199
92100instance Taggable (ExceptT tag e m) where
93101 type Tag (ExceptT tag e m) = 'Just tag
src/Control/Monad/Trans/Ether/Reader.hs+17−8
@@ -37,6 +37,7 @@ import qualified Control.Newtype as NT
3737import qualified Control.Monad.Trans.Control as MC
3838import qualified Control.Monad.Trans.Reader as Trans
3939
40+import qualified Control.Monad.Trans.Lift.StT as Lift
4041import qualified Control.Monad.Trans.Lift.Local as Lift
4142import qualified Control.Monad.Trans.Lift.Catch as Lift
4243import qualified Control.Monad.Trans.Lift.Listen as Lift
@@ -62,7 +63,7 @@ type Reader tag r = ReaderT tag r Identity
6263--
6364-- The 'return' function ignores the environment, while '>>=' passes
6465-- the inherited environment to both subcomputations.
65−newtype ReaderT tag r m a = RT { runRT :: Trans.ReaderT r m a }
66+newtype ReaderT tag r m a = ReaderT (Trans.ReaderT r m a)
6667 deriving ( Generic
6768 , Functor, Applicative, Alternative, Monad, MonadPlus
6869 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
@@ -71,18 +72,26 @@ instance NT.Newtype (ReaderT tag r m a)
7172
7273instance MC.MonadTransControl (ReaderT tag r) where
7374 type StT (ReaderT tag r) a = MC.StT (Trans.ReaderT r) a
74− liftWith = MC.defaultLiftWith RT runRT
75− restoreT = MC.defaultRestoreT RT
75+ liftWith = MC.defaultLiftWith NT.pack NT.unpack
76+ restoreT = MC.defaultRestoreT NT.pack
7677
77−instance Lift.LiftLocal (ReaderT tag r)
78−instance Lift.LiftCatch (ReaderT tag r)
79−instance Lift.LiftListen (ReaderT tag r)
78+type instance Lift.StT (ReaderT tag r) a = MC.StT (ReaderT tag r) a
79+
80+instance Lift.LiftLocal (ReaderT tag r) where
81+ liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack
82+
83+instance Lift.LiftCatch (ReaderT tag r) where
84+ liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack
85+
86+instance Lift.LiftListen (ReaderT tag r) where
87+ liftListen = Lift.defaultLiftListen NT.pack NT.unpack
8088
8189instance Lift.LiftPass (ReaderT tag r) where
82− liftPass pass m = RT $ Lift.liftPass pass (runRT m)
90+ liftPass = Lift.defaultLiftPass NT.pack NT.unpack
8391
8492instance Lift.LiftCallCC (ReaderT tag r) where
85− liftCallCC callCC f = RT $ Lift.liftCallCC callCC (\g -> (runRT . f) (RT . g))
93+ liftCallCC = Lift.defaultLiftCallCC NT.pack NT.unpack
94+ liftCallCC' = Lift.defaultLiftCallCC' NT.pack NT.unpack
8695
8796instance Taggable (ReaderT tag r m) where
8897 type Tag (ReaderT tag r m) = 'Just tag
src/Control/Monad/Trans/Ether/State/Lazy.hs+17−9
@@ -41,6 +41,7 @@ import qualified Control.Newtype as NT
4141import qualified Control.Monad.Trans.Control as MC
4242import qualified Control.Monad.Trans.State.Lazy as Trans
4343
44+import qualified Control.Monad.Trans.Lift.StT as Lift
4445import qualified Control.Monad.Trans.Lift.Local as Lift
4546import qualified Control.Monad.Trans.Lift.Catch as Lift
4647import qualified Control.Monad.Trans.Lift.Listen as Lift
@@ -66,7 +67,7 @@ type State tag r = StateT tag r Identity
6667--
6768-- The 'return' function leaves the state unchanged, while '>>=' uses
6869-- the final state of the first computation as the initial state of the second.
69−newtype StateT tag s m a = ST { runST :: Trans.StateT s m a }
70+newtype StateT tag s m a = StateT (Trans.StateT s m a)
7071 deriving ( Generic
7172 , Functor, Applicative, Alternative, Monad, MonadPlus
7273 , MonadFix, MonadTrans, MonadIO, MFunctor )
@@ -75,19 +76,26 @@ instance NT.Newtype (StateT tag s m a)
7576
7677instance MC.MonadTransControl (StateT tag s) where
7778 type StT (StateT tag s) a = MC.StT (Trans.StateT s) a
78− liftWith = MC.defaultLiftWith ST runST
79− restoreT = MC.defaultRestoreT ST
79+ liftWith = MC.defaultLiftWith NT.pack NT.unpack
80+ restoreT = MC.defaultRestoreT NT.pack
8081
81−instance Lift.LiftLocal (StateT tag s)
82−instance Lift.LiftCatch (StateT tag s)
83−instance Lift.LiftListen (StateT tag s)
82+type instance Lift.StT (StateT tag s) a = MC.StT (StateT tag s) a
83+
84+instance Lift.LiftLocal (StateT tag s) where
85+ liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack
86+
87+instance Lift.LiftCatch (StateT tag s) where
88+ liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack
89+
90+instance Lift.LiftListen (StateT tag s) where
91+ liftListen = Lift.defaultLiftListen NT.pack NT.unpack
8492
8593instance Lift.LiftPass (StateT tag s) where
86− liftPass pass m = ST $ Lift.liftPass pass (runST m)
94+ liftPass = Lift.defaultLiftPass NT.pack NT.unpack
8795
8896instance Lift.LiftCallCC (StateT tag s) where
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))
97+ liftCallCC = Lift.defaultLiftCallCC NT.pack NT.unpack
98+ liftCallCC' = Lift.defaultLiftCallCC' NT.pack NT.unpack
9199
92100instance Taggable (StateT tag s m) where
93101 type Tag (StateT tag s m) = 'Just tag
src/Control/Monad/Trans/Ether/State/Strict.hs+17−9
@@ -41,6 +41,7 @@ import qualified Control.Newtype as NT
4141import qualified Control.Monad.Trans.Control as MC
4242import qualified Control.Monad.Trans.State.Strict as Trans
4343
44+import qualified Control.Monad.Trans.Lift.StT as Lift
4445import qualified Control.Monad.Trans.Lift.Local as Lift
4546import qualified Control.Monad.Trans.Lift.Catch as Lift
4647import qualified Control.Monad.Trans.Lift.Listen as Lift
@@ -66,7 +67,7 @@ type State tag r = StateT tag r Identity
6667--
6768-- The 'return' function leaves the state unchanged, while '>>=' uses
6869-- the final state of the first computation as the initial state of the second.
69−newtype StateT tag s m a = ST { runST :: Trans.StateT s m a }
70+newtype StateT tag s m a = StateT (Trans.StateT s m a)
7071 deriving ( Generic
7172 , Functor, Applicative, Alternative, Monad, MonadPlus
7273 , MonadFix, MonadTrans, MonadIO, MFunctor )
@@ -75,19 +76,26 @@ instance NT.Newtype (StateT tag s m a)
7576
7677instance MC.MonadTransControl (StateT tag s) where
7778 type StT (StateT tag s) a = MC.StT (Trans.StateT s) a
78− liftWith = MC.defaultLiftWith ST runST
79− restoreT = MC.defaultRestoreT ST
79+ liftWith = MC.defaultLiftWith NT.pack NT.unpack
80+ restoreT = MC.defaultRestoreT NT.pack
8081
81−instance Lift.LiftLocal (StateT tag s)
82−instance Lift.LiftCatch (StateT tag s)
83−instance Lift.LiftListen (StateT tag s)
82+type instance Lift.StT (StateT tag s) a = MC.StT (StateT tag s) a
83+
84+instance Lift.LiftLocal (StateT tag s) where
85+ liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack
86+
87+instance Lift.LiftCatch (StateT tag s) where
88+ liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack
89+
90+instance Lift.LiftListen (StateT tag s) where
91+ liftListen = Lift.defaultLiftListen NT.pack NT.unpack
8492
8593instance Lift.LiftPass (StateT tag s) where
86− liftPass pass m = ST $ Lift.liftPass pass (runST m)
94+ liftPass = Lift.defaultLiftPass NT.pack NT.unpack
8795
8896instance Lift.LiftCallCC (StateT tag s) where
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))
97+ liftCallCC = Lift.defaultLiftCallCC NT.pack NT.unpack
98+ liftCallCC' = Lift.defaultLiftCallCC' NT.pack NT.unpack
9199
92100instance Taggable (StateT tag s m) where
93101 type Tag (StateT tag s m) = 'Just tag
src/Control/Monad/Trans/Ether/Writer.hs+17−8
@@ -45,6 +45,7 @@ import qualified Control.Newtype as NT
4545import qualified Control.Monad.Trans.Control as MC
4646import qualified Control.Monad.Trans.Writer.Lazy as Trans
4747
48+import qualified Control.Monad.Trans.Lift.StT as Lift
4849import qualified Control.Monad.Trans.Lift.Local as Lift
4950import qualified Control.Monad.Trans.Lift.Catch as Lift
5051import qualified Control.Monad.Trans.Lift.Listen as Lift
@@ -69,7 +70,7 @@ type Writer tag w = WriterT tag w Identity
6970--
7071-- The 'return' function produces the output 'mempty', while '>>=' combines
7172-- the outputs of the subcomputations using 'mappend'.
72−newtype WriterT tag w m a = WT { runWT :: Trans.WriterT w m a }
73+newtype WriterT tag w m a = WriterT (Trans.WriterT w m a)
7374 deriving ( Generic
7475 , Functor, Applicative, Alternative, Monad, MonadPlus
7576 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
@@ -78,18 +79,26 @@ instance NT.Newtype (WriterT tag w m a)
7879
7980instance Monoid w => MC.MonadTransControl (WriterT tag w) where
8081 type StT (WriterT tag w) a = MC.StT (Trans.WriterT w) a
81− liftWith = MC.defaultLiftWith WT runWT
82− restoreT = MC.defaultRestoreT WT
82+ liftWith = MC.defaultLiftWith NT.pack NT.unpack
83+ restoreT = MC.defaultRestoreT NT.pack
8384
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)
85+type instance Lift.StT (WriterT tag w) a = MC.StT (WriterT tag w) a
86+
87+instance Monoid w => Lift.LiftLocal (WriterT tag w) where
88+ liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack
89+
90+instance Monoid w => Lift.LiftCatch (WriterT tag w) where
91+ liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack
92+
93+instance Monoid w => Lift.LiftListen (WriterT tag w) where
94+ liftListen = Lift.defaultLiftListen NT.pack NT.unpack
8795
8896instance Monoid w' => Lift.LiftPass (WriterT tag w') where
89− liftPass pass' m = WT $ Lift.liftPass pass' (runWT m)
97+ liftPass = Lift.defaultLiftPass NT.pack NT.unpack
9098
9199instance Monoid w => Lift.LiftCallCC (WriterT tag w) where
92− liftCallCC callCC f = WT $ Lift.liftCallCC callCC (\g -> (runWT . f) (WT . g))
100+ liftCallCC = Lift.defaultLiftCallCC WT runWT
101+ liftCallCC' = Lift.defaultLiftCallCC WT runWT
93102
94103instance Taggable (WriterT tag w m) where
95104 type Tag (WriterT tag w m) = 'Just tag