@@ -1,55 +1,118 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE RankNTypes #-}
2−{-# LANGUAGE DefaultSignatures #-}
3+-- | Lifting the 'local' operation.
34module Control.Monad.Trans.Lift.Local
45 ( LiftLocal(..)
56 , Local
7+ , defaultLiftLocal
68 , module Control.Monad.Trans.Class
79 ) where
810
11+#if __GLASGOW_HASKELL__ < 710
912import Data.Monoid
13+#endif
1014
1115import Control.Monad.Trans.Class
12−import Control.Monad.Morph
13−
14−import Control.Monad.Trans.Except
15−import Control.Monad.Trans.Identity
16−import Control.Monad.Trans.List
17−import Control.Monad.Trans.Maybe
18−import Control.Monad.Trans.Reader
19−import qualified Control.Monad.Trans.Cont as Cont
20−import qualified Control.Monad.Trans.RWS.Lazy as Lazy
21−import qualified Control.Monad.Trans.RWS.Strict as Strict
22−import qualified Control.Monad.Trans.State.Lazy as Lazy
23−import qualified Control.Monad.Trans.State.Strict as Strict
24−import qualified Control.Monad.Trans.Writer.Lazy as Lazy
25−import qualified Control.Monad.Trans.Writer.Strict as Strict
2616
17+import qualified Control.Monad.Trans.Cont as C
18+import qualified Control.Monad.Trans.Except as E
19+import qualified Control.Monad.Trans.Identity as I
20+import qualified Control.Monad.Trans.List as L
21+import qualified Control.Monad.Trans.Maybe as M
22+import qualified Control.Monad.Trans.Reader as R
23+import qualified Control.Monad.Trans.RWS.Lazy as RWS.Lazy
24+import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict
25+import qualified Control.Monad.Trans.RWS.CPS as RWS.CPS
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+import qualified Control.Monad.Trans.Writer.CPS as W.CPS
31+
32+#if MIN_VERSION_transformers(0,5,3)
33+import qualified Control.Monad.Trans.Accum as Acc
34+#endif
35+
36+-- | Signature of the @local@ operation,
37+-- introduced in "Control.Monad.Trans.Reader".
2738type Local r m a = (r -> r) -> m a -> m a
2839
40+-- | The class of monad transformers capable of lifting 'local'.
2941class MonadTrans t => LiftLocal t where
30− liftLocal
31− :: Monad m
32− => m r
33− -> (forall a . Local r m a)
34− -> (forall a . Local r (t m) a)
35− default liftLocal
36− :: (Monad m, MFunctor t)
37− => m r
38− -> (forall a . Local r m a)
39− -> (forall a . Local r (t m) a)
40− liftLocal _ l f = hoist (l f)
41−
42−instance LiftLocal (Cont.ContT r)
43− where liftLocal a l f = Cont.liftLocal a l f
44−
45−instance LiftLocal (ExceptT e)
46−instance LiftLocal IdentityT
47−instance LiftLocal ListT
48−instance LiftLocal MaybeT
49−instance LiftLocal (ReaderT r)
50−instance Monoid w => LiftLocal (Lazy.RWST r w s)
51−instance Monoid w => LiftLocal (Strict.RWST r w s)
52−instance LiftLocal (Lazy.StateT s)
53−instance LiftLocal (Strict.StateT s)
54−instance Monoid w => LiftLocal (Lazy.WriterT w)
55−instance Monoid w => LiftLocal (Strict.WriterT w)
42+ -- | Lift the 'local' operation.
43+ liftLocal :: Monad m => m r -> (forall a . Local r m a)
44+ -> (forall a . Local r (t m) a)
45+
46+-- | Default definition for the 'liftLocal' method.
47+defaultLiftLocal
48+ :: (Monad m, LiftLocal n)
49+ => (forall x . n m x -> t m x)
50+ -- ^ Monad constructor
51+ -> (forall o x . t o x -> n o x)
52+ -- ^ Monad deconstructor
53+ -> m r
54+ -> (forall a . Local r m a)
55+ -> (forall a . Local r (t m) a)
56+defaultLiftLocal t unT a l f = t . liftLocal a l f . unT
57+
58+instance LiftLocal (C.ContT r) where
59+ liftLocal a l f = C.liftLocal a l f
60+ {-# INLINE liftLocal #-}
61+
62+instance LiftLocal (E.ExceptT e) where
63+ liftLocal _ l f = E.mapExceptT (l f)
64+ {-# INLINE liftLocal #-}
65+
66+instance LiftLocal I.IdentityT where
67+ liftLocal _ l f = I.mapIdentityT (l f)
68+ {-# INLINE liftLocal #-}
69+
70+instance LiftLocal L.ListT where
71+ liftLocal _ l f = L.mapListT (l f)
72+ {-# INLINE liftLocal #-}
73+
74+instance LiftLocal M.MaybeT where
75+ liftLocal _ l f = M.mapMaybeT (l f)
76+ {-# INLINE liftLocal #-}
77+
78+instance LiftLocal (R.ReaderT r) where
79+ liftLocal _ l f = R.mapReaderT (l f)
80+ {-# INLINE liftLocal #-}
81+
82+instance Monoid w => LiftLocal (RWS.Lazy.RWST r w s) where
83+ liftLocal _ l f = RWS.Lazy.mapRWST (l f)
84+ {-# INLINE liftLocal #-}
85+
86+instance Monoid w => LiftLocal (RWS.Strict.RWST r w s) where
87+ liftLocal _ l f = RWS.Strict.mapRWST (l f)
88+ {-# INLINE liftLocal #-}
89+
90+instance Monoid w => LiftLocal (RWS.CPS.RWST r w s) where
91+ liftLocal _ l f = RWS.CPS.mapRWST (l f)
92+ {-# INLINE liftLocal #-}
93+
94+instance LiftLocal (S.Lazy.StateT s) where
95+ liftLocal _ l f = S.Lazy.mapStateT (l f)
96+ {-# INLINE liftLocal #-}
97+
98+instance LiftLocal (S.Strict.StateT s) where
99+ liftLocal _ l f = S.Strict.mapStateT (l f)
100+ {-# INLINE liftLocal #-}
101+
102+instance Monoid w => LiftLocal (W.Lazy.WriterT w) where
103+ liftLocal _ l f = W.Lazy.mapWriterT (l f)
104+ {-# INLINE liftLocal #-}
105+
106+instance Monoid w => LiftLocal (W.Strict.WriterT w) where
107+ liftLocal _ l f = W.Strict.mapWriterT (l f)
108+ {-# INLINE liftLocal #-}
109+
110+instance Monoid w => LiftLocal (W.CPS.WriterT w) where
111+ liftLocal _ l f = W.CPS.mapWriterT (l f)
112+ {-# INLINE liftLocal #-}
113+
114+#if MIN_VERSION_transformers(0,5,3)
115+instance Monoid w => LiftLocal (Acc.AccumT w) where
116+ liftLocal _ l f = Acc.mapAccumT (l f)
117+ {-# INLINE liftLocal #-}
118+#endif