git.iko.soy/typeable/transformers-lift
on master help sign in
Do not use monad-control
commit46bd407cd1b599cbb7db20795369a66220cbc1d2 authorIndex Int <vlad.z.4096@gmail.com> dateSat 11 Jul 2015, 18:39 (11 years ago) parenteb3905a
6 files changed+180−79
compare with master
unifiedsplit
src/Control/Monad/Trans/Lift/CallCC.hs+32−13 src/Control/Monad/Trans/Lift/Catch.hs+57−35 src/Control/Monad/Trans/Lift/Listen.hs+48−20 src/Control/Monad/Trans/Lift/Pass.hs+13−5 src/Control/Monad/Trans/Lift/StT.hs+28 transformers-lift.cabal+2−6
src/Control/Monad/Trans/Lift/CallCC.hs+32−13
@@ -1,9 +1,12 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE RankNTypes #-}
34{-# LANGUAGE UndecidableInstances #-}
45module Control.Monad.Trans.Lift.CallCC
56 ( LiftCallCC(..)
67 , CallCC
8+ , defaultLiftCallCC
9+ , defaultLiftCallCC'
710 , module Control.Monad.Trans.Class
811 ) where
912
@@ -13,7 +16,6 @@ import Data.Monoid
1316
1417import Control.Monad.Signatures
1518import Control.Monad.Trans.Class
16−import Control.Monad.Trans.Control
1719
1820import qualified Control.Monad.Trans.Except as E
1921import qualified Control.Monad.Trans.Identity as I
@@ -27,27 +29,42 @@ import qualified Control.Monad.Trans.State.Strict as S.Strict
2729import qualified Control.Monad.Trans.Writer.Lazy as W.Lazy
2830import qualified Control.Monad.Trans.Writer.Strict as W.Strict
2931
32+import Control.Monad.Trans.Lift.StT
33+
3034class MonadTrans t => LiftCallCC t where
31− type CallCCStT t a
32− type CallCCStT t a = StT t a
33− liftCallCC :: Monad m => CallCC m (CallCCStT t a) (CallCCStT t b) -> CallCC (t m) a b
34− liftCallCC' :: Monad m => CallCC m (CallCCStT t a) (CallCCStT t b) -> CallCC (t m) a b
35− liftCallCC' = liftCallCC
35+ liftCallCC, liftCallCC'
36+ :: Monad m => CallCC m (StT t a) (StT t b) -> CallCC (t m) a b
37+
38+defaultLiftCallCC, defaultLiftCallCC'
39+ :: (Monad m, LiftCallCC n)
40+ => (forall x . n m x -> t m x)
41+ -> (forall o x . t o x -> n o x)
42+ -> CallCC m (StT n a) (StT n b)
43+ -> CallCC (t m) a b
44+defaultLiftCallCC t unT callCC f
45+ = t $ liftCallCC callCC (\g -> (unT . f) (t . g))
46+defaultLiftCallCC' t unT callCC f
47+ = t $ liftCallCC' callCC (\g -> (unT . f) (t . g))
3648
3749instance LiftCallCC (E.ExceptT e) where
38− liftCallCC = E.liftCallCC
50+ liftCallCC = E.liftCallCC
51+ liftCallCC' = E.liftCallCC
3952
4053instance LiftCallCC I.IdentityT where
41− liftCallCC = I.liftCallCC
54+ liftCallCC = I.liftCallCC
55+ liftCallCC' = I.liftCallCC
4256
4357instance LiftCallCC L.ListT where
44− liftCallCC = L.liftCallCC
58+ liftCallCC = L.liftCallCC
59+ liftCallCC' = L.liftCallCC
4560
4661instance LiftCallCC M.MaybeT where
47− liftCallCC = M.liftCallCC
62+ liftCallCC = M.liftCallCC
63+ liftCallCC' = M.liftCallCC
4864
4965instance LiftCallCC (R.ReaderT r) where
50− liftCallCC = R.liftCallCC
66+ liftCallCC = R.liftCallCC
67+ liftCallCC' = R.liftCallCC
5168
5269instance Monoid w => LiftCallCC (RWS.Lazy.RWST r w s) where
5370 liftCallCC = RWS.Lazy.liftCallCC
@@ -66,7 +83,9 @@ instance LiftCallCC (S.Strict.StateT s) where
6683 liftCallCC' = S.Strict.liftCallCC'
6784
6885instance Monoid w => LiftCallCC (W.Lazy.WriterT w) where
69− liftCallCC = W.Lazy.liftCallCC
86+ liftCallCC = W.Lazy.liftCallCC
87+ liftCallCC' = W.Lazy.liftCallCC
7088
7189instance Monoid w => LiftCallCC (W.Strict.WriterT w) where
72− liftCallCC = W.Strict.liftCallCC
90+ liftCallCC = W.Strict.liftCallCC
91+ liftCallCC' = W.Strict.liftCallCC
src/Control/Monad/Trans/Lift/Catch.hs+57−35
@@ -1,10 +1,11 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE RankNTypes #-}
34{-# LANGUAGE UndecidableInstances #-}
4−{-# LANGUAGE DefaultSignatures #-}
55module Control.Monad.Trans.Lift.Catch
66 ( LiftCatch(..)
77 , Catch
8+ , defaultLiftCatch
89 , module Control.Monad.Trans.Class
910 ) where
1011
@@ -14,39 +15,60 @@ import Data.Monoid
1415
1516import Control.Monad.Signatures
1617import Control.Monad.Trans.Class
17−import Control.Monad.Trans.Control
18−
19−import Control.Monad.Trans.Except
20−import Control.Monad.Trans.Identity
21−import Control.Monad.Trans.List
22−import Control.Monad.Trans.Maybe
23−import Control.Monad.Trans.Reader
24−import qualified Control.Monad.Trans.RWS.Lazy as Lazy
25−import qualified Control.Monad.Trans.RWS.Strict as Strict
26−import qualified Control.Monad.Trans.State.Lazy as Lazy
27−import qualified Control.Monad.Trans.State.Strict as Strict
28−import qualified Control.Monad.Trans.Writer.Lazy as Lazy
29−import qualified Control.Monad.Trans.Writer.Strict as Strict
18+
19+import qualified Control.Monad.Trans.Except as E
20+import qualified Control.Monad.Trans.Identity as I
21+import qualified Control.Monad.Trans.List as L
22+import qualified Control.Monad.Trans.Maybe as M
23+import qualified Control.Monad.Trans.Reader as R
24+import qualified Control.Monad.Trans.RWS.Lazy as RWS.Lazy
25+import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict
26+import qualified Control.Monad.Trans.State.Lazy as S.Lazy
27+import qualified Control.Monad.Trans.State.Strict as S.Strict
28+import qualified Control.Monad.Trans.Writer.Lazy as W.Lazy
29+import qualified Control.Monad.Trans.Writer.Strict as W.Strict
30+
31+import Control.Monad.Trans.Lift.StT
3032
3133class MonadTrans t => LiftCatch t where
32− type CatchStT t a
33− type CatchStT t a = StT t a
34− liftCatch :: Monad m => Catch e m (CatchStT t a) -> Catch e (t m) a
35− default liftCatch
36− :: (MonadTransControl t, CatchStT t a ~ StT t a, Monad m, Monad (t m))
37− => Catch e m (CatchStT t a) -> Catch e (t m) a
38− liftCatch catch m h = do
39− st <- liftWith (\run -> catch (run m) (run . h))
40− restoreT (return st)
41−
42−instance LiftCatch (ExceptT e)
43−instance LiftCatch IdentityT
44−instance LiftCatch ListT
45−instance LiftCatch MaybeT
46−instance LiftCatch (ReaderT r)
47−instance Monoid w => LiftCatch (Lazy.RWST r w s)
48−instance Monoid w => LiftCatch (Strict.RWST r w s)
49−instance LiftCatch (Lazy.StateT s)
50−instance LiftCatch (Strict.StateT s)
51−instance Monoid w => LiftCatch (Lazy.WriterT w)
52−instance Monoid w => LiftCatch (Strict.WriterT w)
34+ liftCatch :: Monad m => Catch e m (StT t a) -> Catch e (t m) a
35+
36+defaultLiftCatch
37+ :: (Monad m, LiftCatch n)
38+ => (forall x . n m x -> t m x)
39+ -> (forall o x . t o x -> n o x)
40+ -> Catch e m (StT n a) -> Catch e (t m) a
41+defaultLiftCatch t unT f m h = t $ liftCatch f (unT m) (unT . h)
42+
43+instance LiftCatch (E.ExceptT e) where
44+ liftCatch f m h = E.ExceptT $ f (E.runExceptT m) (E.runExceptT . h)
45+
46+instance LiftCatch I.IdentityT where
47+ liftCatch = I.liftCatch
48+
49+instance LiftCatch L.ListT where
50+ liftCatch = L.liftCatch
51+
52+instance LiftCatch M.MaybeT where
53+ liftCatch = M.liftCatch
54+
55+instance LiftCatch (R.ReaderT r) where
56+ liftCatch = R.liftCatch
57+
58+instance Monoid w => LiftCatch (RWS.Lazy.RWST r w s) where
59+ liftCatch = RWS.Lazy.liftCatch
60+
61+instance Monoid w => LiftCatch (RWS.Strict.RWST r w s) where
62+ liftCatch = RWS.Strict.liftCatch
63+
64+instance LiftCatch (S.Lazy.StateT s) where
65+ liftCatch = S.Lazy.liftCatch
66+
67+instance LiftCatch (S.Strict.StateT s) where
68+ liftCatch = S.Strict.liftCatch
69+
70+instance Monoid w => LiftCatch (W.Lazy.WriterT w) where
71+ liftCatch = W.Lazy.liftCatch
72+
73+instance Monoid w => LiftCatch (W.Strict.WriterT w) where
74+ liftCatch = W.Strict.liftCatch
src/Control/Monad/Trans/Lift/Listen.hs+48−20
@@ -1,10 +1,11 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE TypeFamilies #-}
33{-# LANGUAGE UndecidableInstances #-}
4−{-# LANGUAGE DefaultSignatures #-}
4+{-# LANGUAGE RankNTypes #-}
55module Control.Monad.Trans.Lift.Listen
66 ( LiftListen(..)
77 , Listen
8+ , defaultLiftListen
89 , module Control.Monad.Trans.Class
910 ) where
1011
@@ -14,7 +15,6 @@ import Data.Monoid
1415
1516import Control.Monad.Signatures
1617import Control.Monad.Trans.Class
17−import Control.Monad.Trans.Control
1818
1919import qualified Control.Monad.Trans.Except as E
2020import qualified Control.Monad.Trans.Identity as I
@@ -27,24 +27,52 @@ import qualified Control.Monad.Trans.State.Strict as S.Strict
2727import qualified Control.Monad.Trans.Writer.Lazy as W.Lazy
2828import qualified Control.Monad.Trans.Writer.Strict as W.Strict
2929
30+import Control.Monad.Trans.Lift.StT
31+
3032class MonadTrans t => LiftListen t where
31− type ListenStT t a
32− type ListenStT t a = StT t a
33− liftListen :: Monad m => Listen w m (ListenStT t a) -> Listen w (t m) a
34− default liftListen
35− :: (MonadTransControl t, ListenStT t a ~ StT t a, Monad m, Monad (t m))
36− => Listen w m (ListenStT t a) -> Listen w (t m) a
37− liftListen listen m = do
38− (st, w) <- liftWith (\run -> listen (run m))
39− flip (,) w `fmap` restoreT (return st)
40−
41−instance LiftListen (E.ExceptT e)
42−instance LiftListen I.IdentityT
43−instance LiftListen M.MaybeT
44−instance LiftListen (R.ReaderT r)
45−instance LiftListen (S.Lazy.StateT s)
46−instance LiftListen (S.Strict.StateT s)
33+ liftListen :: Monad m => Listen w m (StT t a) -> Listen w (t m) a
34+
35+defaultLiftListen
36+ :: (Monad m, LiftListen n)
37+ => (forall x . n m x -> t m x)
38+ -> (forall o x . t o x -> n o x)
39+ -> Listen w m (StT n a) -> Listen w (t m) a
40+defaultLiftListen t unT listen m = t $ liftListen listen (unT m)
41+
42+instance LiftListen (E.ExceptT e) where
43+ liftListen = E.liftListen
44+
45+instance LiftListen I.IdentityT where
46+ liftListen = I.mapIdentityT
47+
48+instance LiftListen M.MaybeT where
49+ liftListen = M.liftListen
50+
51+instance LiftListen (R.ReaderT r) where
52+ liftListen = R.mapReaderT
53+
54+instance LiftListen (S.Lazy.StateT s) where
55+ liftListen = S.Lazy.liftListen
56+
57+instance LiftListen (S.Strict.StateT s) where
58+ liftListen = S.Strict.liftListen
59+
4760instance Monoid w => LiftListen (RWS.Lazy.RWST r w s) where
61+ liftListen listen m = RWS.Lazy.RWST $ \r s -> do
62+ ((a, w', s'), w) <- listen (RWS.Lazy.runRWST m r s)
63+ return ((a, w), w', s')
64+
4865instance Monoid w => LiftListen (RWS.Strict.RWST r w s) where
49−instance Monoid w => LiftListen (W.Lazy.WriterT w)
50−instance Monoid w => LiftListen (W.Strict.WriterT w)
66+ liftListen listen m = RWS.Strict.RWST $ \r s -> do
67+ ((a, w', s'), w) <- listen (RWS.Strict.runRWST m r s)
68+ return ((a, w), w', s')
69+
70+instance Monoid w => LiftListen (W.Lazy.WriterT w) where
71+ liftListen listen m = W.Lazy.WriterT $ do
72+ ~((a, w'), w) <- listen (W.Lazy.runWriterT m)
73+ return ((a, w), w')
74+
75+instance Monoid w => LiftListen (W.Strict.WriterT w) where
76+ liftListen listen m = W.Strict.WriterT $ do
77+ ((a, w'), w) <- listen (W.Strict.runWriterT m)
78+ return ((a, w), w')
src/Control/Monad/Trans/Lift/Pass.hs+13−5
@@ -1,9 +1,11 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE RankNTypes #-}
34{-# LANGUAGE UndecidableInstances #-}
45module Control.Monad.Trans.Lift.Pass
56 ( LiftPass(..)
67 , Pass
8+ , defaultLiftPass
79 , module Control.Monad.Trans.Class
810 ) where
911
@@ -13,7 +15,6 @@ import Data.Monoid
1315
1416import Control.Monad.Signatures
1517import Control.Monad.Trans.Class
16−import Control.Monad.Trans.Control
1718
1819import qualified Control.Monad.Trans.Except as E
1920import qualified Control.Monad.Trans.Identity as I
@@ -24,11 +25,18 @@ import qualified Control.Monad.Trans.State.Strict as S.Strict
2425import qualified Control.Monad.Trans.Writer.Lazy as W.Lazy
2526import qualified Control.Monad.Trans.Writer.Strict as W.Strict
2627
28+import Control.Monad.Trans.Lift.StT
29+
2730class MonadTrans t => LiftPass t where
28− type PassStT t a
29− type PassStT t a = StT t a
30− liftPass :: Monad m => Pass w m (PassStT t a) -> Pass w (t m) a
31− -- TODO: investigate how MonadTransControl can be used for default definition
31+ liftPass :: Monad m => Pass w m (StT t a) -> Pass w (t m) a
32+
33+defaultLiftPass
34+ :: (Monad m, LiftPass n)
35+ => (forall x . n m x -> t m x)
36+ -> (forall o x . t o x -> n o x)
37+ -> Pass w m (StT n a)
38+ -> Pass w (t m) a
39+defaultLiftPass t unT pass m = t $ liftPass pass (unT m)
3240
3341instance LiftPass (E.ExceptT e) where
3442 liftPass = E.liftPass
src/Control/Monad/Trans/Lift/StT.hsnew file+28
@@ -0,0 +1,28 @@
1+{-# LANGUAGE TypeFamilies #-}
2+{-# LANGUAGE KindSignatures #-}
3+module Control.Monad.Trans.Lift.StT where
4+
5+import qualified Control.Monad.Trans.Except as E
6+import qualified Control.Monad.Trans.Identity as I
7+import qualified Control.Monad.Trans.List as L
8+import qualified Control.Monad.Trans.Maybe as M
9+import qualified Control.Monad.Trans.Reader as R
10+import qualified Control.Monad.Trans.RWS.Lazy as RWS.Lazy
11+import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict
12+import qualified Control.Monad.Trans.State.Lazy as S.Lazy
13+import qualified Control.Monad.Trans.State.Strict as S.Strict
14+import qualified Control.Monad.Trans.Writer.Lazy as W.Lazy
15+import qualified Control.Monad.Trans.Writer.Strict as W.Strict
16+
17+type family StT (t :: (* -> *) -> (* -> *)) (a :: *) :: *
18+type instance StT (E.ExceptT e) a = Either e a
19+type instance StT I.IdentityT a = a
20+type instance StT L.ListT a = [a]
21+type instance StT M.MaybeT a = Maybe a
22+type instance StT (R.ReaderT r) a = a
23+type instance StT (RWS.Lazy.RWST r w s) a = (a, s, w)
24+type instance StT (RWS.Strict.RWST r w s) a = (a, s, w)
25+type instance StT (S.Lazy.StateT s) a = (a, s)
26+type instance StT (S.Strict.StateT s) a = (a, s)
27+type instance StT (W.Strict.WriterT w) a = (a, w)
28+type instance StT (W.Lazy.WriterT w) a = (a, w)
transformers-lift.cabal+2−6
@@ -18,18 +18,14 @@ library
1818 Control.Monad.Trans.Lift.Catch
1919 Control.Monad.Trans.Lift.Listen
2020 Control.Monad.Trans.Lift.Pass
21+ Control.Monad.Trans.Lift.StT
2122 -- other-modules:
2223 build-depends: base >=4.7 && <4.9
2324 , transformers >= 0.4.2
2425 , mmorph >= 1.0.4
25− , monad-control >= 1.0.0.4
2626
2727 default-language: Haskell2010
28− other-extensions: CPP
29− DefaultSignatures
30− RankNTypes
31− TypeFamilies
32− UndecidableInstances
28+ -- other-extensions:
3329
3430 hs-source-dirs: src
3531 ghc-options: -Wall