@@ -1,7 +1,6 @@
11{-# LANGUAGE CPP #-}
2−{-# LANGUAGE TypeFamilies #-}
32{-# LANGUAGE RankNTypes #-}
4−{-# LANGUAGE UndecidableInstances #-}
3+-- | Lifting the @callCC@ operation.
54module Control.Monad.Trans.Lift.CallCC
65 ( LiftCallCC(..)
76 , CallCC
@@ -24,68 +23,124 @@ import qualified Control.Monad.Trans.Maybe as M
2423import qualified Control.Monad.Trans.Reader as R
2524import qualified Control.Monad.Trans.RWS.Lazy as RWS.Lazy
2625import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict
26+import qualified Control.Monad.Trans.RWS.CPS as RWS.CPS
2727import qualified Control.Monad.Trans.State.Lazy as S.Lazy
2828import qualified Control.Monad.Trans.State.Strict as S.Strict
2929import qualified Control.Monad.Trans.Writer.Lazy as W.Lazy
3030import qualified Control.Monad.Trans.Writer.Strict as W.Strict
31+import qualified Control.Monad.Trans.Writer.CPS as W.CPS
32+
33+#if MIN_VERSION_transformers(0,5,3)
34+import qualified Control.Monad.Trans.Accum as Acc
35+#endif
3136
3237import Control.Monad.Trans.Lift.StT
3338
39+-- | The class of monad transformers capable of lifting 'callCC'.
3440class MonadTrans t => LiftCallCC t where
35− liftCallCC, liftCallCC'
36− :: Monad m => CallCC m (StT t a) (StT t b) -> CallCC (t m) a b
37−
38−defaultLiftCallCC, defaultLiftCallCC'
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
54+ liftCallCC' = liftCallCC
55+
56+-- | Default definition for the 'liftCallCC' method.
57+defaultLiftCallCC
3958 :: (Monad m, LiftCallCC n)
4059 => (forall x . n m x -> t m x)
60+ -- ^ Monad constructor
4161 -> (forall o x . t o x -> n o x)
62+ -- ^ Monad deconstructor
4263 -> CallCC m (StT n a) (StT n b)
4364 -> CallCC (t m) a b
4465defaultLiftCallCC t unT callCC f
4566 = 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
4677defaultLiftCallCC' t unT callCC f
4778 = t $ liftCallCC' callCC (\g -> (unT . f) (t . g))
4879
4980instance LiftCallCC (E.ExceptT e) where
5081 liftCallCC = E.liftCallCC
51− liftCallCC' = E.liftCallCC
82+ {-# INLINE liftCallCC #-}
5283
5384instance LiftCallCC I.IdentityT where
5485 liftCallCC = I.liftCallCC
55− liftCallCC' = I.liftCallCC
86+ {-# INLINE liftCallCC #-}
5687
5788instance LiftCallCC L.ListT where
5889 liftCallCC = L.liftCallCC
59− liftCallCC' = L.liftCallCC
90+ {-# INLINE liftCallCC #-}
6091
6192instance LiftCallCC M.MaybeT where
6293 liftCallCC = M.liftCallCC
63− liftCallCC' = M.liftCallCC
94+ {-# INLINE liftCallCC #-}
6495
6596instance LiftCallCC (R.ReaderT r) where
6697 liftCallCC = R.liftCallCC
67− 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 #-}
68111
69112instance Monoid w => LiftCallCC (RWS.Lazy.RWST r w s) where
70113 liftCallCC = RWS.Lazy.liftCallCC
114+ {-# INLINE liftCallCC #-}
71115 liftCallCC' = RWS.Lazy.liftCallCC'
116+ {-# INLINE liftCallCC' #-}
72117
73118instance Monoid w => LiftCallCC (RWS.Strict.RWST r w s) where
74119 liftCallCC = RWS.Strict.liftCallCC
120+ {-# INLINE liftCallCC #-}
75121 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' #-}
76129
77130instance LiftCallCC (S.Lazy.StateT s) where
78131 liftCallCC = S.Lazy.liftCallCC
132+ {-# INLINE liftCallCC #-}
79133 liftCallCC' = S.Lazy.liftCallCC'
134+ {-# INLINE liftCallCC' #-}
80135
81136instance LiftCallCC (S.Strict.StateT s) where
82137 liftCallCC = S.Strict.liftCallCC
138+ {-# INLINE liftCallCC #-}
83139 liftCallCC' = S.Strict.liftCallCC'
140+ {-# INLINE liftCallCC' #-}
84141
85−instance Monoid w => LiftCallCC (W.Lazy.WriterT w) where
86− liftCallCC = W.Lazy.liftCallCC
87− liftCallCC' = W.Lazy.liftCallCC
88−
89−instance Monoid w => LiftCallCC (W.Strict.WriterT w) where
90− liftCallCC = W.Strict.liftCallCC
91− 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