@@ -1,9 +1,11 @@
11{-# LANGUAGE CPP #-}
2−{-# LANGUAGE TypeFamilies #-}
3−{-# LANGUAGE UndecidableInstances #-}
2+{-# LANGUAGE RankNTypes #-}
3+-- | Lifting the @callCC@ operation.
44module Control.Monad.Trans.Lift.CallCC
55 ( LiftCallCC(..)
66 , CallCC
7+ , defaultLiftCallCC
8+ , defaultLiftCallCC'
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
@@ -22,51 +23,124 @@ import qualified Control.Monad.Trans.Maybe as M
2223import qualified Control.Monad.Trans.Reader as R
2324import qualified Control.Monad.Trans.RWS.Lazy as RWS.Lazy
2425import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict
26+import qualified Control.Monad.Trans.RWS.CPS as RWS.CPS
2527import qualified Control.Monad.Trans.State.Lazy as S.Lazy
2628import 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
31+import qualified Control.Monad.Trans.Writer.CPS as W.CPS
2932
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'.
3040class 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
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
3554 liftCallCC' = liftCallCC
3655
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+
3780instance LiftCallCC (E.ExceptT e) where
38− liftCallCC = E.liftCallCC
81+ liftCallCC = E.liftCallCC
82+ {-# INLINE liftCallCC #-}
3983
4084instance LiftCallCC I.IdentityT where
41− liftCallCC = I.liftCallCC
85+ liftCallCC = I.liftCallCC
86+ {-# INLINE liftCallCC #-}
4287
4388instance LiftCallCC L.ListT where
44− liftCallCC = L.liftCallCC
89+ liftCallCC = L.liftCallCC
90+ {-# INLINE liftCallCC #-}
4591
4692instance LiftCallCC M.MaybeT where
47− liftCallCC = M.liftCallCC
93+ liftCallCC = M.liftCallCC
94+ {-# INLINE liftCallCC #-}
4895
4996instance LiftCallCC (R.ReaderT r) where
50− liftCallCC = R.liftCallCC
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 #-}
51111
52112instance Monoid w => LiftCallCC (RWS.Lazy.RWST r w s) where
53113 liftCallCC = RWS.Lazy.liftCallCC
114+ {-# INLINE liftCallCC #-}
54115 liftCallCC' = RWS.Lazy.liftCallCC'
116+ {-# INLINE liftCallCC' #-}
55117
56118instance Monoid w => LiftCallCC (RWS.Strict.RWST r w s) where
57119 liftCallCC = RWS.Strict.liftCallCC
120+ {-# INLINE liftCallCC #-}
58121 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' #-}
59129
60130instance LiftCallCC (S.Lazy.StateT s) where
61131 liftCallCC = S.Lazy.liftCallCC
132+ {-# INLINE liftCallCC #-}
62133 liftCallCC' = S.Lazy.liftCallCC'
134+ {-# INLINE liftCallCC' #-}
63135
64136instance LiftCallCC (S.Strict.StateT s) where
65137 liftCallCC = S.Strict.liftCallCC
138+ {-# INLINE liftCallCC #-}
66139 liftCallCC' = S.Strict.liftCallCC'
140+ {-# INLINE liftCallCC' #-}
67141
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
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