on master help sign in
MonadBase and MonadBaseControl instances
commit7b21efccaa188860e2e1c5fa346f588d10b120ac authorIndex Int <vlad.z.4096@gmail.com> dateSun 12 Jul 2015, 01:37 (11 years ago) parente0731a7
6 files changed+49−3
ether.cabal+2−1 src/Control/Monad/Trans/Ether/Except.hs+9 src/Control/Monad/Trans/Ether/Reader.hs+9 src/Control/Monad/Trans/Ether/State/Lazy.hs+9 src/Control/Monad/Trans/Ether/State/Strict.hs+9 src/Control/Monad/Trans/Ether/Writer.hs+11−2
ether.cabal+2−1
@@ -58,10 +58,11 @@ library
5858
5959 build-depends: base >=4.7 && <4.9
6060 , transformers >=0.4.2
61− , transformers-lift >=0.0
61+ , transformers-lift >=0.1
6262 , mtl >=2.2.1
6363 , mmorph >=1.0.4
6464 , monad-control >=1.0.0.4
65+ , transformers-base >=0.4.4
6566 , template-haskell >=2.9
6667 , newtype-generics >=0.4.1
6768
src/Control/Monad/Trans/Ether/Except.hs+9
@@ -34,6 +34,7 @@ import Control.Ether.Tagged (Taggable(..), Tagged(..))
3434import GHC.Generics (Generic)
3535import qualified Control.Newtype as NT
3636
37+import qualified Control.Monad.Base as MB
3738import qualified Control.Monad.Trans.Control as MC
3839import qualified Control.Monad.Trans.Except as Trans
3940
@@ -74,11 +75,19 @@ newtype ExceptT tag e m a = ExceptT (Trans.ExceptT e m a)
7475
7576instance NT.Newtype (ExceptT tag e m a)
7677
78+instance MB.MonadBase b m => MB.MonadBase b (ExceptT tag e m) where
79+ liftBase = MB.liftBaseDefault
80+
7781instance MC.MonadTransControl (ExceptT tag e) where
7882 type StT (ExceptT tag e) a = MC.StT (Trans.ExceptT e) a
7983 liftWith = MC.defaultLiftWith NT.pack NT.unpack
8084 restoreT = MC.defaultRestoreT NT.pack
8185
86+instance MC.MonadBaseControl b m => MC.MonadBaseControl b (ExceptT tag e m) where
87+ type StM (ExceptT tag e m) a = MC.ComposeSt (ExceptT tag e) m a
88+ liftBaseWith = MC.defaultLiftBaseWith
89+ restoreM = MC.defaultRestoreM
90+
8291type instance Lift.StT (ExceptT tag e) a = MC.StT (ExceptT tag e) a
8392
8493instance Lift.LiftLocal (ExceptT tag e) where
src/Control/Monad/Trans/Ether/Reader.hs+9
@@ -34,6 +34,7 @@ import Control.Ether.Tagged (Taggable(..), Tagged(..))
3434import GHC.Generics (Generic)
3535import qualified Control.Newtype as NT
3636
37+import qualified Control.Monad.Base as MB
3738import qualified Control.Monad.Trans.Control as MC
3839import qualified Control.Monad.Trans.Reader as Trans
3940
@@ -70,11 +71,19 @@ newtype ReaderT tag r m a = ReaderT (Trans.ReaderT r m a)
7071
7172instance NT.Newtype (ReaderT tag r m a)
7273
74+instance MB.MonadBase b m => MB.MonadBase b (ReaderT tag r m) where
75+ liftBase = MB.liftBaseDefault
76+
7377instance MC.MonadTransControl (ReaderT tag r) where
7478 type StT (ReaderT tag r) a = MC.StT (Trans.ReaderT r) a
7579 liftWith = MC.defaultLiftWith NT.pack NT.unpack
7680 restoreT = MC.defaultRestoreT NT.pack
7781
82+instance MC.MonadBaseControl b m => MC.MonadBaseControl b (ReaderT tag r m) where
83+ type StM (ReaderT tag r m) a = MC.ComposeSt (ReaderT tag r) m a
84+ liftBaseWith = MC.defaultLiftBaseWith
85+ restoreM = MC.defaultRestoreM
86+
7887type instance Lift.StT (ReaderT tag r) a = MC.StT (ReaderT tag r) a
7988
8089instance Lift.LiftLocal (ReaderT tag r) where
src/Control/Monad/Trans/Ether/State/Lazy.hs+9
@@ -38,6 +38,7 @@ import Control.Ether.Tagged (Taggable(..), Tagged(..))
3838import GHC.Generics (Generic)
3939import qualified Control.Newtype as NT
4040
41+import qualified Control.Monad.Base as MB
4142import qualified Control.Monad.Trans.Control as MC
4243import qualified Control.Monad.Trans.State.Lazy as Trans
4344
@@ -74,11 +75,19 @@ newtype StateT tag s m a = StateT (Trans.StateT s m a)
7475
7576instance NT.Newtype (StateT tag s m a)
7677
78+instance MB.MonadBase b m => MB.MonadBase b (StateT tag s m) where
79+ liftBase = MB.liftBaseDefault
80+
7781instance MC.MonadTransControl (StateT tag s) where
7882 type StT (StateT tag s) a = MC.StT (Trans.StateT s) a
7983 liftWith = MC.defaultLiftWith NT.pack NT.unpack
8084 restoreT = MC.defaultRestoreT NT.pack
8185
86+instance MC.MonadBaseControl b m => MC.MonadBaseControl b (StateT tag s m) where
87+ type StM (StateT tag s m) a = MC.ComposeSt (StateT tag s) m a
88+ liftBaseWith = MC.defaultLiftBaseWith
89+ restoreM = MC.defaultRestoreM
90+
8291type instance Lift.StT (StateT tag s) a = MC.StT (StateT tag s) a
8392
8493instance Lift.LiftLocal (StateT tag s) where
src/Control/Monad/Trans/Ether/State/Strict.hs+9
@@ -38,6 +38,7 @@ import Control.Ether.Tagged (Taggable(..), Tagged(..))
3838import GHC.Generics (Generic)
3939import qualified Control.Newtype as NT
4040
41+import qualified Control.Monad.Base as MB
4142import qualified Control.Monad.Trans.Control as MC
4243import qualified Control.Monad.Trans.State.Strict as Trans
4344
@@ -74,11 +75,19 @@ newtype StateT tag s m a = StateT (Trans.StateT s m a)
7475
7576instance NT.Newtype (StateT tag s m a)
7677
78+instance MB.MonadBase b m => MB.MonadBase b (StateT tag s m) where
79+ liftBase = MB.liftBaseDefault
80+
7781instance MC.MonadTransControl (StateT tag s) where
7882 type StT (StateT tag s) a = MC.StT (Trans.StateT s) a
7983 liftWith = MC.defaultLiftWith NT.pack NT.unpack
8084 restoreT = MC.defaultRestoreT NT.pack
8185
86+instance MC.MonadBaseControl b m => MC.MonadBaseControl b (StateT tag s m) where
87+ type StM (StateT tag s m) a = MC.ComposeSt (StateT tag s) m a
88+ liftBaseWith = MC.defaultLiftBaseWith
89+ restoreM = MC.defaultRestoreM
90+
8291type instance Lift.StT (StateT tag s) a = MC.StT (StateT tag s) a
8392
8493instance Lift.LiftLocal (StateT tag s) where
src/Control/Monad/Trans/Ether/Writer.hs+11−2
@@ -42,6 +42,7 @@ import Control.Ether.Tagged (Taggable(..), Tagged(..))
4242import GHC.Generics (Generic)
4343import qualified Control.Newtype as NT
4444
45+import qualified Control.Monad.Base as MB
4546import qualified Control.Monad.Trans.Control as MC
4647import qualified Control.Monad.Trans.Writer.Lazy as Trans
4748
@@ -77,11 +78,19 @@ newtype WriterT tag w m a = WriterT (Trans.WriterT w m a)
7778
7879instance NT.Newtype (WriterT tag w m a)
7980
81+instance (Monoid w, MB.MonadBase b m) => MB.MonadBase b (WriterT tag w m) where
82+ liftBase = MB.liftBaseDefault
83+
8084instance Monoid w => MC.MonadTransControl (WriterT tag w) where
8185 type StT (WriterT tag w) a = MC.StT (Trans.WriterT w) a
8286 liftWith = MC.defaultLiftWith NT.pack NT.unpack
8387 restoreT = MC.defaultRestoreT NT.pack
8488
89+instance (Monoid w, MC.MonadBaseControl b m) => MC.MonadBaseControl b (WriterT tag w m) where
90+ type StM (WriterT tag w m) a = MC.ComposeSt (WriterT tag w) m a
91+ liftBaseWith = MC.defaultLiftBaseWith
92+ restoreM = MC.defaultRestoreM
93+
8594type instance Lift.StT (WriterT tag w) a = MC.StT (WriterT tag w) a
8695
8796instance Monoid w => Lift.LiftLocal (WriterT tag w) where
@@ -97,8 +106,8 @@ instance Monoid w' => Lift.LiftPass (WriterT tag w') where
97106 liftPass = Lift.defaultLiftPass NT.pack NT.unpack
98107
99108instance Monoid w => Lift.LiftCallCC (WriterT tag w) where
100− liftCallCC = Lift.defaultLiftCallCC WT runWT
101− liftCallCC' = Lift.defaultLiftCallCC WT runWT
109+ liftCallCC = Lift.defaultLiftCallCC NT.pack NT.unpack
110+ liftCallCC' = Lift.defaultLiftCallCC NT.pack NT.unpack
102111
103112instance Taggable (WriterT tag w m) where
104113 type Tag (WriterT tag w m) = 'Just tag