@@ -1,52 +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
8+ , module Control.Monad.Trans.Class
69 ) where
710
11+#if __GLASGOW_HASKELL__ < 710
12+import Data.Monoid
13+#endif
14+
815import Control.Monad.Trans.Class
9−import Control.Monad.Morph
10−
11−import Control.Monad.Trans.Except
12−import Control.Monad.Trans.Identity
13−import Control.Monad.Trans.List
14−import Control.Monad.Trans.Maybe
15−import Control.Monad.Trans.Reader
16−import qualified Control.Monad.Trans.Cont as Cont
17−import qualified Control.Monad.Trans.RWS.Lazy as Lazy
18−import qualified Control.Monad.Trans.RWS.Strict as Strict
19−import qualified Control.Monad.Trans.State.Lazy as Lazy
20−import qualified Control.Monad.Trans.State.Strict as Strict
21−import qualified Control.Monad.Trans.Writer.Lazy as Lazy
22−import qualified Control.Monad.Trans.Writer.Strict as Strict
2316
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".
2438type Local r m a = (r -> r) -> m a -> m a
2539
40+-- | The class of monad transformers capable of lifting 'local'.
2641class MonadTrans t => LiftLocal t where
27− liftLocal
28− :: Monad m
29− => m r
30− -> (forall a . Local r m a)
31− -> (forall a . Local r (t m) a)
32− default liftLocal
33− :: (Monad m, MFunctor t)
34− => m r
35− -> (forall a . Local r m a)
36− -> (forall a . Local r (t m) a)
37− liftLocal _ l f = hoist (l f)
38−
39−instance LiftLocal (Cont.ContT r)
40− where liftLocal = Cont.liftLocal
41−
42−instance LiftLocal (ExceptT e)
43−instance LiftLocal IdentityT
44−instance LiftLocal ListT
45−instance LiftLocal MaybeT
46−instance LiftLocal (ReaderT r)
47−instance Monoid w => LiftLocal (Lazy.RWST r w s)
48−instance Monoid w => LiftLocal (Strict.RWST r w s)
49−instance LiftLocal (Lazy.StateT s)
50−instance LiftLocal (Strict.StateT s)
51−instance Monoid w => LiftLocal (Lazy.WriterT w)
52−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