@@ -1,11 +1,9 @@
11{-# LANGUAGE CPP #-}
2−{-# LANGUAGE RankNTypes #-}
3−-- | Lifting the @callCC@ operation.
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE UndecidableInstances #-}
44module Control.Monad.Trans.Lift.CallCC
55 ( LiftCallCC(..)
66 , CallCC
7− , defaultLiftCallCC
8− , defaultLiftCallCC'
97 , module Control.Monad.Trans.Class
108 ) where
119
@@ -15,6 +13,7 @@ import Data.Monoid
1513
1614import Control.Monad.Signatures
1715import Control.Monad.Trans.Class
16+import Control.Monad.Trans.Control
1817
1918import qualified Control.Monad.Trans.Except as E
2019import qualified Control.Monad.Trans.Identity as I
@@ -23,124 +22,51 @@ import qualified Control.Monad.Trans.Maybe as M
2322import qualified Control.Monad.Trans.Reader as R
2423import qualified Control.Monad.Trans.RWS.Lazy as RWS.Lazy
2524import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict
26−import qualified Control.Monad.Trans.RWS.CPS as RWS.CPS
2725import qualified Control.Monad.Trans.State.Lazy as S.Lazy
2826import qualified Control.Monad.Trans.State.Strict as S.Strict
2927import qualified Control.Monad.Trans.Writer.Lazy as W.Lazy
3028import qualified Control.Monad.Trans.Writer.Strict as W.Strict
31−import qualified Control.Monad.Trans.Writer.CPS as W.CPS
3229
33−#if MIN_VERSION_transformers(0,5,3)
34−import qualified Control.Monad.Trans.Accum as Acc
35−#endif
36−
37−import Control.Monad.Trans.Lift.StT
38−
39−-- | The class of monad transformers capable of lifting 'callCC'.
4030class MonadTrans t => LiftCallCC t where
41− -- | Lift the @callCC@ operation.
42− -- Should satisfy the uniformity property
43− --
44− -- * @'lift' (f k) = f' ('lift' . k) => 'lift' (cf f) = 'liftCallCC' cf f'@
45− --
46− liftCallCC :: Monad m => CallCC m (StT t a) (StT t b) -> CallCC (t m) a b
47−
48− -- | Lift the @callCC@ operation.
49− -- This is an alternative version of 'liftCallCC' included for historical
50− -- reasons. It has a different lifting behavior for the @StateT@ and @RWST@
51− -- monad transformers. Matches what @mtl@ does but doesn't satisfy the
52− -- uniformity property.
53− liftCallCC' :: Monad m => CallCC m (StT t a) (StT t b) -> CallCC (t m) a b
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
5435 liftCallCC' = liftCallCC
5536
56−-- | Default definition for the 'liftCallCC' method.
57−defaultLiftCallCC
58− :: (Monad m, LiftCallCC n)
59− => (forall x . n m x -> t m x)
60− -- ^ Monad constructor
61− -> (forall o x . t o x -> n o x)
62− -- ^ Monad deconstructor
63− -> CallCC m (StT n a) (StT n b)
64− -> CallCC (t m) a b
65−defaultLiftCallCC t unT callCC f
66− = t $ liftCallCC callCC (\g -> (unT . f) (t . g))
67−
68−-- | Default definition for the 'liftCallCC'' method.
69−defaultLiftCallCC'
70− :: (Monad m, LiftCallCC n)
71− => (forall x . n m x -> t m x)
72− -- ^ Monad constructor
73− -> (forall o x . t o x -> n o x)
74− -- ^ Monad deconstructor
75− -> CallCC m (StT n a) (StT n b)
76− -> CallCC (t m) a b
77−defaultLiftCallCC' t unT callCC f
78− = t $ liftCallCC' callCC (\g -> (unT . f) (t . g))
79−
8037instance LiftCallCC (E.ExceptT e) where
81− liftCallCC = E.liftCallCC
82− {-# INLINE liftCallCC #-}
38+ liftCallCC = E.liftCallCC
8339
8440instance LiftCallCC I.IdentityT where
85− liftCallCC = I.liftCallCC
86− {-# INLINE liftCallCC #-}
41+ liftCallCC = I.liftCallCC
8742
8843instance LiftCallCC L.ListT where
89− liftCallCC = L.liftCallCC
90− {-# INLINE liftCallCC #-}
44+ liftCallCC = L.liftCallCC
9145
9246instance LiftCallCC M.MaybeT where
93− liftCallCC = M.liftCallCC
94− {-# INLINE liftCallCC #-}
47+ liftCallCC = M.liftCallCC
9548
9649instance LiftCallCC (R.ReaderT r) where
97− liftCallCC = R.liftCallCC
98− {-# INLINE liftCallCC #-}
99−
100−instance Monoid w => LiftCallCC (W.Lazy.WriterT w) where
101− liftCallCC = W.Lazy.liftCallCC
102− {-# INLINE liftCallCC #-}
103−
104−instance Monoid w => LiftCallCC (W.Strict.WriterT w) where
105− liftCallCC = W.Strict.liftCallCC
106− {-# INLINE liftCallCC #-}
107−
108−instance Monoid w => LiftCallCC (W.CPS.WriterT w) where
109− liftCallCC = W.CPS.liftCallCC
110− {-# INLINE liftCallCC #-}
50+ liftCallCC = R.liftCallCC
11151
11252instance Monoid w => LiftCallCC (RWS.Lazy.RWST r w s) where
11353 liftCallCC = RWS.Lazy.liftCallCC
114− {-# INLINE liftCallCC #-}
11554 liftCallCC' = RWS.Lazy.liftCallCC'
116− {-# INLINE liftCallCC' #-}
11755
11856instance Monoid w => LiftCallCC (RWS.Strict.RWST r w s) where
11957 liftCallCC = RWS.Strict.liftCallCC
120− {-# INLINE liftCallCC #-}
12158 liftCallCC' = RWS.Strict.liftCallCC'
122− {-# INLINE liftCallCC' #-}
123−
124−instance Monoid w => LiftCallCC (RWS.CPS.RWST r w s) where
125− liftCallCC = RWS.CPS.liftCallCC
126− {-# INLINE liftCallCC #-}
127− liftCallCC' = RWS.CPS.liftCallCC'
128− {-# INLINE liftCallCC' #-}
12959
13060instance LiftCallCC (S.Lazy.StateT s) where
13161 liftCallCC = S.Lazy.liftCallCC
132− {-# INLINE liftCallCC #-}
13362 liftCallCC' = S.Lazy.liftCallCC'
134− {-# INLINE liftCallCC' #-}
13563
13664instance LiftCallCC (S.Strict.StateT s) where
13765 liftCallCC = S.Strict.liftCallCC
138− {-# INLINE liftCallCC #-}
13966 liftCallCC' = S.Strict.liftCallCC'
140− {-# INLINE liftCallCC' #-}
14167
142−#if MIN_VERSION_transformers(0,5,3)
143−instance Monoid w => LiftCallCC (Acc.AccumT w) where
144− liftCallCC = Acc.liftCallCC
145− {-# INLINE liftCallCC #-}
146−#endif
68+instance Monoid w => LiftCallCC (W.Lazy.WriterT w) where
69+ liftCallCC = W.Lazy.liftCallCC
70+
71+instance Monoid w => LiftCallCC (W.Strict.WriterT w) where
72+ liftCallCC = W.Strict.liftCallCC