git.iko.soy/typeable/ether
on master help sign in
Use liftCallCC from transformers-lift
commitdaca8842aebbff0e0e741f2c47f1f8564e498ad8 authorIndex Int <vlad.z.4096@gmail.com> dateFri 19 Jun 2015, 14:55 (11 years ago) parentabfee98
5 files changed+27−52
compare with master
unifiedsplit
src/Control/Monad/Trans/Ether/Except.hs+5−9 src/Control/Monad/Trans/Ether/Reader.hs+5−9 src/Control/Monad/Trans/Ether/State/Lazy.hs+6−11 src/Control/Monad/Trans/Ether/State/Strict.hs+6−11 src/Control/Monad/Trans/Ether/Writer.hs+5−12
src/Control/Monad/Trans/Ether/Except.hs+5−9
@@ -21,11 +21,8 @@ module Control.Monad.Trans.Ether.Except
2121 -- * Exception operations
2222 , throw
2323 , catch
24− -- * Lifting other operations
25− , liftCallCC
2624 ) where
2725
28−import Data.Proxy (Proxy(Proxy))
2926import Data.Functor.Identity (Identity(..))
3027import Data.Coerce (coerce)
3128import Control.Applicative
@@ -38,7 +35,6 @@ import Control.Ether.Tagged (Taggable(..), Tagged(..))
3835import GHC.Generics (Generic)
3936import qualified Control.Newtype as NT
4037
41−import qualified Control.Monad.Signatures as Sig
4238import qualified Control.Monad.Trans.Control as MC
4339import qualified Control.Monad.Trans.Except as Trans
4440
@@ -46,6 +42,7 @@ import qualified Control.Monad.Trans.Lift.Local as Lift
4642import qualified Control.Monad.Trans.Lift.Catch as Lift
4743import qualified Control.Monad.Trans.Lift.Listen as Lift
4844import qualified Control.Monad.Trans.Lift.Pass as Lift
45+import qualified Control.Monad.Trans.Lift.CallCC as Lift
4946
5047import qualified Control.Monad.Cont.Class as Class
5148import qualified Control.Monad.Reader.Class as Class
@@ -92,6 +89,9 @@ instance Lift.LiftListen (ExceptT tag e) where
9289instance Lift.LiftPass (ExceptT tag e) where
9390 liftPass pass m = ExceptT $ Lift.liftPass pass (coerce m)
9491
92+instance Lift.LiftCallCC (ExceptT tag e) where
93+ liftCallCC callCC f = ExceptT $ Lift.liftCallCC callCC (coerce f)
94+
9595instance Taggable (ExceptT tag e m) where
9696 type Tag (ExceptT tag e m) = 'Just tag
9797 type Inner (ExceptT tag e m) = 'Just m
@@ -120,12 +120,8 @@ throw t = tagged t . Trans.throwE
120120catch :: Monad m => proxy tag -> ExceptT tag e m a -> (e -> ExceptT tag e m a) -> ExceptT tag e m a
121121catch t m h = tagged t $ Trans.catchE (coerce m) (coerce . h)
122122
123−-- | Lift a @callCC@ operation to the new monad.
124−liftCallCC :: proxy tag -> Sig.CallCC m (Either e a) (Either e b) -> Sig.CallCC (ExceptT tag e m) a b
125−liftCallCC t callCC f = tagged t $ Trans.liftCallCC callCC (coerce f)
126−
127123instance Class.MonadCont m => Class.MonadCont (ExceptT tag e m) where
128− callCC = liftCallCC Proxy Class.callCC
124+ callCC = Lift.liftCallCC Class.callCC
129125
130126instance Class.MonadReader r m => Class.MonadReader r (ExceptT tag e m) where
131127 ask = lift Class.ask
src/Control/Monad/Trans/Ether/Reader.hs+5−9
@@ -21,11 +21,8 @@ module Control.Monad.Trans.Ether.Reader
2121 -- * Reader operations
2222 , ask
2323 , local
24− -- * Lifting other operations
25− , liftCallCC
2624 ) where
2725
28−import Data.Proxy (Proxy(Proxy))
2926import Data.Functor.Identity (Identity(..))
3027import Data.Coerce (coerce)
3128import Control.Applicative
@@ -38,7 +35,6 @@ import Control.Ether.Tagged (Taggable(..), Tagged(..))
3835import GHC.Generics (Generic)
3936import qualified Control.Newtype as NT
4037
41−import qualified Control.Monad.Signatures as Sig
4238import qualified Control.Monad.Trans.Control as MC
4339import qualified Control.Monad.Trans.Reader as Trans
4440
@@ -46,6 +42,7 @@ import qualified Control.Monad.Trans.Lift.Local as Lift
4642import qualified Control.Monad.Trans.Lift.Catch as Lift
4743import qualified Control.Monad.Trans.Lift.Listen as Lift
4844import qualified Control.Monad.Trans.Lift.Pass as Lift
45+import qualified Control.Monad.Trans.Lift.CallCC as Lift
4946
5047import qualified Control.Monad.Cont.Class as Class
5148import qualified Control.Monad.Reader.Class as Class
@@ -87,6 +84,9 @@ instance Lift.LiftListen (ReaderT tag r) where
8784instance Lift.LiftPass (ReaderT tag r) where
8885 liftPass pass m = ReaderT $ Lift.liftPass pass (coerce m)
8986
87+instance Lift.LiftCallCC (ReaderT tag r) where
88+ liftCallCC callCC f = ReaderT $ Lift.liftCallCC callCC (coerce f)
89+
9090instance Taggable (ReaderT tag r m) where
9191 type Tag (ReaderT tag r m) = 'Just tag
9292 type Inner (ReaderT tag r m) = 'Just m
@@ -113,10 +113,6 @@ runReaderT t = Trans.runReaderT . untagged t
113113runReader :: proxy tag -> Reader tag r a -> r -> a
114114runReader t = Trans.runReader . untagged t
115115
116−-- | Lift a @callCC@ operation to the new monad.
117−liftCallCC :: proxy tag -> Sig.CallCC m a b -> Sig.CallCC (ReaderT tag r m) a b
118−liftCallCC t callCC f = tagged t $ Trans.liftCallCC callCC (coerce f)
119−
120116-- | Fetch the value of the environment.
121117ask :: Monad m => proxy tag -> ReaderT tag r m r
122118ask t = tagged t Trans.ask
@@ -137,7 +133,7 @@ local t f m = tagged t $ Trans.withReaderT f (coerce m)
137133-- Instances for mtl classes
138134
139135instance Class.MonadCont m => Class.MonadCont (ReaderT tag r m) where
140− callCC = liftCallCC Proxy Class.callCC
136+ callCC = Lift.liftCallCC Class.callCC
141137
142138instance Class.MonadReader r' m => Class.MonadReader r' (ReaderT tag r m) where
143139 ask = lift Class.ask
src/Control/Monad/Trans/Ether/State/Lazy.hs+6−11
@@ -25,11 +25,8 @@ module Control.Monad.Trans.Ether.State.Lazy
2525 -- * State operations
2626 , get
2727 , put
28− -- * Litfing other operations
29− , liftCallCC'
3028 ) where
3129
32−import Data.Proxy (Proxy(Proxy))
3330import Data.Functor.Identity (Identity(..))
3431import Data.Coerce (coerce)
3532import Control.Applicative
@@ -42,7 +39,6 @@ import Control.Ether.Tagged (Taggable(..), Tagged(..))
4239import GHC.Generics (Generic)
4340import qualified Control.Newtype as NT
4441
45−import qualified Control.Monad.Signatures as Sig
4642import qualified Control.Monad.Trans.Control as MC
4743import qualified Control.Monad.Trans.State.Lazy as Trans
4844
@@ -50,6 +46,7 @@ import qualified Control.Monad.Trans.Lift.Local as Lift
5046import qualified Control.Monad.Trans.Lift.Catch as Lift
5147import qualified Control.Monad.Trans.Lift.Listen as Lift
5248import qualified Control.Monad.Trans.Lift.Pass as Lift
49+import qualified Control.Monad.Trans.Lift.CallCC as Lift
5350
5451import qualified Control.Monad.Cont.Class as Class
5552import qualified Control.Monad.Reader.Class as Class
@@ -91,6 +88,10 @@ instance Lift.LiftListen (StateT tag s) where
9188instance Lift.LiftPass (StateT tag s) where
9289 liftPass pass m = StateT $ Lift.liftPass pass (coerce m)
9390
91+instance 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)
94+
9495instance Taggable (StateT tag s m) where
9596 type Tag (StateT tag s m) = 'Just tag
9697 type Inner (StateT tag s m) = 'Just m
@@ -145,16 +146,10 @@ get t = tagged t Trans.get
145146put :: Monad m => proxy tag -> s -> StateT tag s m ()
146147put t = tagged t . Trans.put
147148
148−-- | In-situ lifting of a @callCC@ operation to the new monad.
149−-- This version uses the current state on entering the continuation.
150−-- It does not satisfy the uniformity property (see "Control.Monad.Signatures").
151−liftCallCC' :: proxy tag -> Sig.CallCC m (a, s) (b, s) -> Sig.CallCC (StateT tag s m) a b
152−liftCallCC' t callCC f = tagged t $ Trans.liftCallCC' callCC (coerce f)
153−
154149-- Instances for mtl classes
155150
156151instance Class.MonadCont m => Class.MonadCont (StateT tag s m) where
157− callCC = liftCallCC' Proxy Class.callCC
152+ callCC = Lift.liftCallCC' Class.callCC
158153
159154instance Class.MonadReader r m => Class.MonadReader r (StateT tag s m) where
160155 ask = lift Class.ask
src/Control/Monad/Trans/Ether/State/Strict.hs+6−11
@@ -25,11 +25,8 @@ module Control.Monad.Trans.Ether.State.Strict
2525 -- * State operations
2626 , get
2727 , put
28− -- * Litfing other operations
29− , liftCallCC'
3028 ) where
3129
32−import Data.Proxy (Proxy(Proxy))
3330import Data.Functor.Identity (Identity(..))
3431import Data.Coerce (coerce)
3532import Control.Applicative
@@ -42,7 +39,6 @@ import Control.Ether.Tagged (Taggable(..), Tagged(..))
4239import GHC.Generics (Generic)
4340import qualified Control.Newtype as NT
4441
45−import qualified Control.Monad.Signatures as Sig
4642import qualified Control.Monad.Trans.Control as MC
4743import qualified Control.Monad.Trans.State.Strict as Trans
4844
@@ -50,6 +46,7 @@ import qualified Control.Monad.Trans.Lift.Local as Lift
5046import qualified Control.Monad.Trans.Lift.Catch as Lift
5147import qualified Control.Monad.Trans.Lift.Listen as Lift
5248import qualified Control.Monad.Trans.Lift.Pass as Lift
49+import qualified Control.Monad.Trans.Lift.CallCC as Lift
5350
5451import qualified Control.Monad.Cont.Class as Class
5552import qualified Control.Monad.Reader.Class as Class
@@ -91,6 +88,10 @@ instance Lift.LiftListen (StateT tag s) where
9188instance Lift.LiftPass (StateT tag s) where
9289 liftPass pass m = StateT $ Lift.liftPass pass (coerce m)
9390
91+instance 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)
94+
9495instance Taggable (StateT tag s m) where
9596 type Tag (StateT tag s m) = 'Just tag
9697 type Inner (StateT tag s m) = 'Just m
@@ -145,16 +146,10 @@ get t = tagged t Trans.get
145146put :: Monad m => proxy tag -> s -> StateT tag s m ()
146147put t = tagged t . Trans.put
147148
148−-- | In-situ lifting of a @callCC@ operation to the new monad.
149−-- This version uses the current state on entering the continuation.
150−-- It does not satisfy the uniformity property (see "Control.Monad.Signatures").
151−liftCallCC' :: proxy tag -> Sig.CallCC m (a, s) (b, s) -> Sig.CallCC (StateT tag s m) a b
152−liftCallCC' t callCC f = tagged t $ Trans.liftCallCC' callCC (coerce f)
153−
154149-- Instances for mtl classes
155150
156151instance Class.MonadCont m => Class.MonadCont (StateT tag s m) where
157− callCC = liftCallCC' Proxy Class.callCC
152+ callCC = Lift.liftCallCC' Class.callCC
158153
159154instance Class.MonadReader r m => Class.MonadReader r (StateT tag s m) where
160155 ask = lift Class.ask
src/Control/Monad/Trans/Ether/Writer.hs+5−12
@@ -25,15 +25,12 @@ module Control.Monad.Trans.Ether.Writer
2525 , tell
2626 , listen
2727 , pass
28− -- * Lifting other operations
29− , liftCallCC
3028 ) where
3129
3230#if __GLASGOW_HASKELL__ < 710
3331import Data.Monoid
3432#endif
3533
36−import Data.Proxy (Proxy(Proxy))
3734import Data.Functor.Identity (Identity(..))
3835import Data.Coerce (coerce)
3936import Control.Applicative
@@ -46,7 +43,6 @@ import Control.Ether.Tagged (Taggable(..), Tagged(..))
4643import GHC.Generics (Generic)
4744import qualified Control.Newtype as NT
4845
49−import qualified Control.Monad.Signatures as Sig
5046import qualified Control.Monad.Trans.Control as MC
5147import qualified Control.Monad.Trans.Writer.Lazy as Trans
5248
@@ -54,6 +50,7 @@ import qualified Control.Monad.Trans.Lift.Local as Lift
5450import qualified Control.Monad.Trans.Lift.Catch as Lift
5551import qualified Control.Monad.Trans.Lift.Listen as Lift
5652import qualified Control.Monad.Trans.Lift.Pass as Lift
53+import qualified Control.Monad.Trans.Lift.CallCC as Lift
5754
5855import qualified Control.Monad.Cont.Class as Class
5956import qualified Control.Monad.Reader.Class as Class
@@ -94,6 +91,9 @@ instance Monoid w' => Lift.LiftListen (WriterT tag w') where
9491instance Monoid w' => Lift.LiftPass (WriterT tag w') where
9592 liftPass pass m = WriterT $ Lift.liftPass pass (coerce m)
9693
94+instance Monoid w => Lift.LiftCallCC (WriterT tag w) where
95+ liftCallCC callCC f = WriterT $ Lift.liftCallCC callCC (coerce f)
96+
9797instance Taggable (WriterT tag w m) where
9898 type Tag (WriterT tag w m) = 'Just tag
9999 type Inner (WriterT tag w m) = 'Just m
@@ -130,9 +130,6 @@ execWriterT t = Trans.execWriterT . untagged t
130130execWriter :: proxy tag -> Writer tag w a -> w
131131execWriter t = Trans.execWriter . untagged t
132132
133−-- | Transform the computation inside a 'WriterT'.
134−--
135−
136133-- | Appends a value to the accumulator within the monad.
137134tell :: Monad m => proxy tag -> w -> WriterT tag w m ()
138135tell t w = writer t ((), w)
@@ -146,12 +143,8 @@ listen t m = tagged t $ Trans.listen (coerce m)
146143pass :: (Monoid w, Monad m) => proxy tag -> WriterT tag w m (a, w -> w) -> WriterT tag w m a
147144pass t m = tagged t $ Trans.pass (coerce m)
148145
149−-- | Lift a @callCC@ operation to the new monad.
150−liftCallCC :: Monoid w => proxy tag -> Sig.CallCC m (a, w) (b, w) -> Sig.CallCC (WriterT tag w m) a b
151−liftCallCC t callCC f = tagged t $ Trans.liftCallCC callCC (coerce f)
152−
153146instance (Monoid w, Class.MonadCont m) => Class.MonadCont (WriterT tag w m) where
154− callCC = liftCallCC Proxy Class.callCC
147+ callCC = Lift.liftCallCC Class.callCC
155148
156149instance (Monoid w, Class.MonadReader r m) => Class.MonadReader r (WriterT tag w m) where
157150 ask = lift Class.ask