git.iko.soy/typeable/ether
on master help sign in
Use liftCallCC from transformers-lift
daca884Index Int
src/Control/Monad/Trans/Ether/Except.hs+5−9
compare with master
unifiedsplit
@@ -21,11 +21,8 @@ module Control.Monad.Trans.Ether.Except
21 -- * Exception operations
21 -- * Exception operations
22 , throw
22 , throw
23 , catch
23 , catch
24− -- * Lifting other operations
25− , liftCallCC
26 ) where
24 ) where
27
25
28−import Data.Proxy (Proxy(Proxy))
29import Data.Functor.Identity (Identity(..))
26import Data.Functor.Identity (Identity(..))
30import Data.Coerce (coerce)
27import Data.Coerce (coerce)
31import Control.Applicative
28import Control.Applicative
@@ -38,7 +35,6 @@ import Control.Ether.Tagged (Taggable(..), Tagged(..))
38import GHC.Generics (Generic)
35import GHC.Generics (Generic)
39import qualified Control.Newtype as NT
36import qualified Control.Newtype as NT
40
37
41−import qualified Control.Monad.Signatures as Sig
42import qualified Control.Monad.Trans.Control as MC
38import qualified Control.Monad.Trans.Control as MC
43import qualified Control.Monad.Trans.Except as Trans
39import qualified Control.Monad.Trans.Except as Trans
44
40
@@ -46,6 +42,7 @@ import qualified Control.Monad.Trans.Lift.Local as Lift
46import qualified Control.Monad.Trans.Lift.Catch as Lift
42import qualified Control.Monad.Trans.Lift.Catch as Lift
47import qualified Control.Monad.Trans.Lift.Listen as Lift
43import qualified Control.Monad.Trans.Lift.Listen as Lift
48import qualified Control.Monad.Trans.Lift.Pass as Lift
44import qualified Control.Monad.Trans.Lift.Pass as Lift
45+import qualified Control.Monad.Trans.Lift.CallCC as Lift
49
46
50import qualified Control.Monad.Cont.Class as Class
47import qualified Control.Monad.Cont.Class as Class
51import qualified Control.Monad.Reader.Class as Class
48import qualified Control.Monad.Reader.Class as Class
@@ -92,6 +89,9 @@ instance Lift.LiftListen (ExceptT tag e) where
92instance Lift.LiftPass (ExceptT tag e) where
89instance Lift.LiftPass (ExceptT tag e) where
93 liftPass pass m = ExceptT $ Lift.liftPass pass (coerce m)
90 liftPass pass m = ExceptT $ Lift.liftPass pass (coerce m)
94
91
92+instance Lift.LiftCallCC (ExceptT tag e) where
93+ liftCallCC callCC f = ExceptT $ Lift.liftCallCC callCC (coerce f)
94+
95instance Taggable (ExceptT tag e m) where
95instance Taggable (ExceptT tag e m) where
96 type Tag (ExceptT tag e m) = 'Just tag
96 type Tag (ExceptT tag e m) = 'Just tag
97 type Inner (ExceptT tag e m) = 'Just m
97 type Inner (ExceptT tag e m) = 'Just m
@@ -120,12 +120,8 @@ throw t = tagged t . Trans.throwE
120catch :: Monad m => proxy tag -> ExceptT tag e m a -> (e -> ExceptT tag e m a) -> ExceptT tag e m a
120catch :: Monad m => proxy tag -> ExceptT tag e m a -> (e -> ExceptT tag e m a) -> ExceptT tag e m a
121catch t m h = tagged t $ Trans.catchE (coerce m) (coerce . h)
121catch t m h = tagged t $ Trans.catchE (coerce m) (coerce . h)
122
122
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−
127instance Class.MonadCont m => Class.MonadCont (ExceptT tag e m) where
123instance Class.MonadCont m => Class.MonadCont (ExceptT tag e m) where
128− callCC = liftCallCC Proxy Class.callCC
124+ callCC = Lift.liftCallCC Class.callCC
129
125
130instance Class.MonadReader r m => Class.MonadReader r (ExceptT tag e m) where
126instance Class.MonadReader r m => Class.MonadReader r (ExceptT tag e m) where
131 ask = lift Class.ask
127 ask = lift Class.ask
src/Control/Monad/Trans/Ether/Reader.hs+5−9
@@ -21,11 +21,8 @@ module Control.Monad.Trans.Ether.Reader
21 -- * Reader operations
21 -- * Reader operations
22 , ask
22 , ask
23 , local
23 , local
24− -- * Lifting other operations
25− , liftCallCC
26 ) where
24 ) where
27
25
28−import Data.Proxy (Proxy(Proxy))
29import Data.Functor.Identity (Identity(..))
26import Data.Functor.Identity (Identity(..))
30import Data.Coerce (coerce)
27import Data.Coerce (coerce)
31import Control.Applicative
28import Control.Applicative
@@ -38,7 +35,6 @@ import Control.Ether.Tagged (Taggable(..), Tagged(..))
38import GHC.Generics (Generic)
35import GHC.Generics (Generic)
39import qualified Control.Newtype as NT
36import qualified Control.Newtype as NT
40
37
41−import qualified Control.Monad.Signatures as Sig
42import qualified Control.Monad.Trans.Control as MC
38import qualified Control.Monad.Trans.Control as MC
43import qualified Control.Monad.Trans.Reader as Trans
39import qualified Control.Monad.Trans.Reader as Trans
44
40
@@ -46,6 +42,7 @@ import qualified Control.Monad.Trans.Lift.Local as Lift
46import qualified Control.Monad.Trans.Lift.Catch as Lift
42import qualified Control.Monad.Trans.Lift.Catch as Lift
47import qualified Control.Monad.Trans.Lift.Listen as Lift
43import qualified Control.Monad.Trans.Lift.Listen as Lift
48import qualified Control.Monad.Trans.Lift.Pass as Lift
44import qualified Control.Monad.Trans.Lift.Pass as Lift
45+import qualified Control.Monad.Trans.Lift.CallCC as Lift
49
46
50import qualified Control.Monad.Cont.Class as Class
47import qualified Control.Monad.Cont.Class as Class
51import qualified Control.Monad.Reader.Class as Class
48import qualified Control.Monad.Reader.Class as Class
@@ -87,6 +84,9 @@ instance Lift.LiftListen (ReaderT tag r) where
87instance Lift.LiftPass (ReaderT tag r) where
84instance Lift.LiftPass (ReaderT tag r) where
88 liftPass pass m = ReaderT $ Lift.liftPass pass (coerce m)
85 liftPass pass m = ReaderT $ Lift.liftPass pass (coerce m)
89
86
87+instance Lift.LiftCallCC (ReaderT tag r) where
88+ liftCallCC callCC f = ReaderT $ Lift.liftCallCC callCC (coerce f)
89+
90instance Taggable (ReaderT tag r m) where
90instance Taggable (ReaderT tag r m) where
91 type Tag (ReaderT tag r m) = 'Just tag
91 type Tag (ReaderT tag r m) = 'Just tag
92 type Inner (ReaderT tag r m) = 'Just m
92 type Inner (ReaderT tag r m) = 'Just m
@@ -113,10 +113,6 @@ runReaderT t = Trans.runReaderT . untagged t
113runReader :: proxy tag -> Reader tag r a -> r -> a
113runReader :: proxy tag -> Reader tag r a -> r -> a
114runReader t = Trans.runReader . untagged t
114runReader t = Trans.runReader . untagged t
115
115
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−
120-- | Fetch the value of the environment.
116-- | Fetch the value of the environment.
121ask :: Monad m => proxy tag -> ReaderT tag r m r
117ask :: Monad m => proxy tag -> ReaderT tag r m r
122ask t = tagged t Trans.ask
118ask t = tagged t Trans.ask
@@ -137,7 +133,7 @@ local t f m = tagged t $ Trans.withReaderT f (coerce m)
137-- Instances for mtl classes
133-- Instances for mtl classes
138
134
139instance Class.MonadCont m => Class.MonadCont (ReaderT tag r m) where
135instance Class.MonadCont m => Class.MonadCont (ReaderT tag r m) where
140− callCC = liftCallCC Proxy Class.callCC
136+ callCC = Lift.liftCallCC Class.callCC
141
137
142instance Class.MonadReader r' m => Class.MonadReader r' (ReaderT tag r m) where
138instance Class.MonadReader r' m => Class.MonadReader r' (ReaderT tag r m) where
143 ask = lift Class.ask
139 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
25 -- * State operations
25 -- * State operations
26 , get
26 , get
27 , put
27 , put
28− -- * Litfing other operations
29− , liftCallCC'
30 ) where
28 ) where
31
29
32−import Data.Proxy (Proxy(Proxy))
33import Data.Functor.Identity (Identity(..))
30import Data.Functor.Identity (Identity(..))
34import Data.Coerce (coerce)
31import Data.Coerce (coerce)
35import Control.Applicative
32import Control.Applicative
@@ -42,7 +39,6 @@ import Control.Ether.Tagged (Taggable(..), Tagged(..))
42import GHC.Generics (Generic)
39import GHC.Generics (Generic)
43import qualified Control.Newtype as NT
40import qualified Control.Newtype as NT
44
41
45−import qualified Control.Monad.Signatures as Sig
46import qualified Control.Monad.Trans.Control as MC
42import qualified Control.Monad.Trans.Control as MC
47import qualified Control.Monad.Trans.State.Lazy as Trans
43import qualified Control.Monad.Trans.State.Lazy as Trans
48
44
@@ -50,6 +46,7 @@ import qualified Control.Monad.Trans.Lift.Local as Lift
50import qualified Control.Monad.Trans.Lift.Catch as Lift
46import qualified Control.Monad.Trans.Lift.Catch as Lift
51import qualified Control.Monad.Trans.Lift.Listen as Lift
47import qualified Control.Monad.Trans.Lift.Listen as Lift
52import qualified Control.Monad.Trans.Lift.Pass as Lift
48import qualified Control.Monad.Trans.Lift.Pass as Lift
49+import qualified Control.Monad.Trans.Lift.CallCC as Lift
53
50
54import qualified Control.Monad.Cont.Class as Class
51import qualified Control.Monad.Cont.Class as Class
55import qualified Control.Monad.Reader.Class as Class
52import qualified Control.Monad.Reader.Class as Class
@@ -91,6 +88,10 @@ instance Lift.LiftListen (StateT tag s) where
91instance Lift.LiftPass (StateT tag s) where
88instance Lift.LiftPass (StateT tag s) where
92 liftPass pass m = StateT $ Lift.liftPass pass (coerce m)
89 liftPass pass m = StateT $ Lift.liftPass pass (coerce m)
93
90
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+
94instance Taggable (StateT tag s m) where
95instance Taggable (StateT tag s m) where
95 type Tag (StateT tag s m) = 'Just tag
96 type Tag (StateT tag s m) = 'Just tag
96 type Inner (StateT tag s m) = 'Just m
97 type Inner (StateT tag s m) = 'Just m
@@ -145,16 +146,10 @@ get t = tagged t Trans.get
145put :: Monad m => proxy tag -> s -> StateT tag s m ()
146put :: Monad m => proxy tag -> s -> StateT tag s m ()
146put t = tagged t . Trans.put
147put t = tagged t . Trans.put
147
148
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−
154-- Instances for mtl classes
149-- Instances for mtl classes
155
150
156instance Class.MonadCont m => Class.MonadCont (StateT tag s m) where
151instance Class.MonadCont m => Class.MonadCont (StateT tag s m) where
157− callCC = liftCallCC' Proxy Class.callCC
152+ callCC = Lift.liftCallCC' Class.callCC
158
153
159instance Class.MonadReader r m => Class.MonadReader r (StateT tag s m) where
154instance Class.MonadReader r m => Class.MonadReader r (StateT tag s m) where
160 ask = lift Class.ask
155 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
25 -- * State operations
25 -- * State operations
26 , get
26 , get
27 , put
27 , put
28− -- * Litfing other operations
29− , liftCallCC'
30 ) where
28 ) where
31
29
32−import Data.Proxy (Proxy(Proxy))
33import Data.Functor.Identity (Identity(..))
30import Data.Functor.Identity (Identity(..))
34import Data.Coerce (coerce)
31import Data.Coerce (coerce)
35import Control.Applicative
32import Control.Applicative
@@ -42,7 +39,6 @@ import Control.Ether.Tagged (Taggable(..), Tagged(..))
42import GHC.Generics (Generic)
39import GHC.Generics (Generic)
43import qualified Control.Newtype as NT
40import qualified Control.Newtype as NT
44
41
45−import qualified Control.Monad.Signatures as Sig
46import qualified Control.Monad.Trans.Control as MC
42import qualified Control.Monad.Trans.Control as MC
47import qualified Control.Monad.Trans.State.Strict as Trans
43import qualified Control.Monad.Trans.State.Strict as Trans
48
44
@@ -50,6 +46,7 @@ import qualified Control.Monad.Trans.Lift.Local as Lift
50import qualified Control.Monad.Trans.Lift.Catch as Lift
46import qualified Control.Monad.Trans.Lift.Catch as Lift
51import qualified Control.Monad.Trans.Lift.Listen as Lift
47import qualified Control.Monad.Trans.Lift.Listen as Lift
52import qualified Control.Monad.Trans.Lift.Pass as Lift
48import qualified Control.Monad.Trans.Lift.Pass as Lift
49+import qualified Control.Monad.Trans.Lift.CallCC as Lift
53
50
54import qualified Control.Monad.Cont.Class as Class
51import qualified Control.Monad.Cont.Class as Class
55import qualified Control.Monad.Reader.Class as Class
52import qualified Control.Monad.Reader.Class as Class
@@ -91,6 +88,10 @@ instance Lift.LiftListen (StateT tag s) where
91instance Lift.LiftPass (StateT tag s) where
88instance Lift.LiftPass (StateT tag s) where
92 liftPass pass m = StateT $ Lift.liftPass pass (coerce m)
89 liftPass pass m = StateT $ Lift.liftPass pass (coerce m)
93
90
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+
94instance Taggable (StateT tag s m) where
95instance Taggable (StateT tag s m) where
95 type Tag (StateT tag s m) = 'Just tag
96 type Tag (StateT tag s m) = 'Just tag
96 type Inner (StateT tag s m) = 'Just m
97 type Inner (StateT tag s m) = 'Just m
@@ -145,16 +146,10 @@ get t = tagged t Trans.get
145put :: Monad m => proxy tag -> s -> StateT tag s m ()
146put :: Monad m => proxy tag -> s -> StateT tag s m ()
146put t = tagged t . Trans.put
147put t = tagged t . Trans.put
147
148
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−
154-- Instances for mtl classes
149-- Instances for mtl classes
155
150
156instance Class.MonadCont m => Class.MonadCont (StateT tag s m) where
151instance Class.MonadCont m => Class.MonadCont (StateT tag s m) where
157− callCC = liftCallCC' Proxy Class.callCC
152+ callCC = Lift.liftCallCC' Class.callCC
158
153
159instance Class.MonadReader r m => Class.MonadReader r (StateT tag s m) where
154instance Class.MonadReader r m => Class.MonadReader r (StateT tag s m) where
160 ask = lift Class.ask
155 ask = lift Class.ask
src/Control/Monad/Trans/Ether/Writer.hs+5−12
@@ -25,15 +25,12 @@ module Control.Monad.Trans.Ether.Writer
25 , tell
25 , tell
26 , listen
26 , listen
27 , pass
27 , pass
28− -- * Lifting other operations
29− , liftCallCC
30 ) where
28 ) where
31
29
32#if __GLASGOW_HASKELL__ < 710
30#if __GLASGOW_HASKELL__ < 710
33import Data.Monoid
31import Data.Monoid
34#endif
32#endif
35
33
36−import Data.Proxy (Proxy(Proxy))
37import Data.Functor.Identity (Identity(..))
34import Data.Functor.Identity (Identity(..))
38import Data.Coerce (coerce)
35import Data.Coerce (coerce)
39import Control.Applicative
36import Control.Applicative
@@ -46,7 +43,6 @@ import Control.Ether.Tagged (Taggable(..), Tagged(..))
46import GHC.Generics (Generic)
43import GHC.Generics (Generic)
47import qualified Control.Newtype as NT
44import qualified Control.Newtype as NT
48
45
49−import qualified Control.Monad.Signatures as Sig
50import qualified Control.Monad.Trans.Control as MC
46import qualified Control.Monad.Trans.Control as MC
51import qualified Control.Monad.Trans.Writer.Lazy as Trans
47import qualified Control.Monad.Trans.Writer.Lazy as Trans
52
48
@@ -54,6 +50,7 @@ import qualified Control.Monad.Trans.Lift.Local as Lift
54import qualified Control.Monad.Trans.Lift.Catch as Lift
50import qualified Control.Monad.Trans.Lift.Catch as Lift
55import qualified Control.Monad.Trans.Lift.Listen as Lift
51import qualified Control.Monad.Trans.Lift.Listen as Lift
56import qualified Control.Monad.Trans.Lift.Pass as Lift
52import qualified Control.Monad.Trans.Lift.Pass as Lift
53+import qualified Control.Monad.Trans.Lift.CallCC as Lift
57
54
58import qualified Control.Monad.Cont.Class as Class
55import qualified Control.Monad.Cont.Class as Class
59import qualified Control.Monad.Reader.Class as Class
56import qualified Control.Monad.Reader.Class as Class
@@ -94,6 +91,9 @@ instance Monoid w' => Lift.LiftListen (WriterT tag w') where
94instance Monoid w' => Lift.LiftPass (WriterT tag w') where
91instance Monoid w' => Lift.LiftPass (WriterT tag w') where
95 liftPass pass m = WriterT $ Lift.liftPass pass (coerce m)
92 liftPass pass m = WriterT $ Lift.liftPass pass (coerce m)
96
93
94+instance Monoid w => Lift.LiftCallCC (WriterT tag w) where
95+ liftCallCC callCC f = WriterT $ Lift.liftCallCC callCC (coerce f)
96+
97instance Taggable (WriterT tag w m) where
97instance Taggable (WriterT tag w m) where
98 type Tag (WriterT tag w m) = 'Just tag
98 type Tag (WriterT tag w m) = 'Just tag
99 type Inner (WriterT tag w m) = 'Just m
99 type Inner (WriterT tag w m) = 'Just m
@@ -130,9 +130,6 @@ execWriterT t = Trans.execWriterT . untagged t
130execWriter :: proxy tag -> Writer tag w a -> w
130execWriter :: proxy tag -> Writer tag w a -> w
131execWriter t = Trans.execWriter . untagged t
131execWriter t = Trans.execWriter . untagged t
132
132
133−-- | Transform the computation inside a 'WriterT'.
134−--
135−
136-- | Appends a value to the accumulator within the monad.
133-- | Appends a value to the accumulator within the monad.
137tell :: Monad m => proxy tag -> w -> WriterT tag w m ()
134tell :: Monad m => proxy tag -> w -> WriterT tag w m ()
138tell t w = writer t ((), w)
135tell t w = writer t ((), w)
@@ -146,12 +143,8 @@ listen t m = tagged t $ Trans.listen (coerce m)
146pass :: (Monoid w, Monad m) => proxy tag -> WriterT tag w m (a, w -> w) -> WriterT tag w m a
143pass :: (Monoid w, Monad m) => proxy tag -> WriterT tag w m (a, w -> w) -> WriterT tag w m a
147pass t m = tagged t $ Trans.pass (coerce m)
144pass t m = tagged t $ Trans.pass (coerce m)
148
145
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−
153instance (Monoid w, Class.MonadCont m) => Class.MonadCont (WriterT tag w m) where
146instance (Monoid w, Class.MonadCont m) => Class.MonadCont (WriterT tag w m) where
154− callCC = liftCallCC Proxy Class.callCC
147+ callCC = Lift.liftCallCC Class.callCC
155
148
156instance (Monoid w, Class.MonadReader r m) => Class.MonadReader r (WriterT tag w m) where
149instance (Monoid w, Class.MonadReader r m) => Class.MonadReader r (WriterT tag w m) where
157 ask = lift Class.ask
150 ask = lift Class.ask