@@ -1,9 +1,10 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE RankNTypes #-}
3−{-# LANGUAGE DefaultSignatures #-}
3+-- | Lifting the 'local' operation.
44module Control.Monad.Trans.Lift.Local
55 ( LiftLocal(..)
66 , Local
7+ , defaultLiftLocal
78 , module Control.Monad.Trans.Class
89 ) where
910
@@ -12,47 +13,106 @@ import Data.Monoid
1213#endif
1314
1415import Control.Monad.Trans.Class
15−import Control.Monad.Morph
16−
17−import Control.Monad.Trans.Except
18−import Control.Monad.Trans.Identity
19−import Control.Monad.Trans.List
20−import Control.Monad.Trans.Maybe
21−import Control.Monad.Trans.Reader
22−import qualified Control.Monad.Trans.Cont as Cont
23−import qualified Control.Monad.Trans.RWS.Lazy as Lazy
24−import qualified Control.Monad.Trans.RWS.Strict as Strict
25−import qualified Control.Monad.Trans.State.Lazy as Lazy
26−import qualified Control.Monad.Trans.State.Strict as Strict
27−import qualified Control.Monad.Trans.Writer.Lazy as Lazy
28−import qualified Control.Monad.Trans.Writer.Strict as Strict
2916
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".
3038type Local r m a = (r -> r) -> m a -> m a
3139
40+-- | The class of monad transformers capable of lifting 'local'.
3241class MonadTrans t => LiftLocal t where
33− liftLocal
34− :: Monad m
35− => m r
36− -> (forall a . Local r m a)
37− -> (forall a . Local r (t m) a)
38− default liftLocal
39− :: (Monad m, MFunctor t)
40− => m r
41− -> (forall a . Local r m a)
42− -> (forall a . Local r (t m) a)
43− liftLocal _ l f = hoist (l f)
44−
45−instance LiftLocal (Cont.ContT r)
46− where liftLocal a l f = Cont.liftLocal a l f
47−
48−instance LiftLocal (ExceptT e)
49−instance LiftLocal IdentityT
50−instance LiftLocal ListT
51−instance LiftLocal MaybeT
52−instance LiftLocal (ReaderT r)
53−instance Monoid w => LiftLocal (Lazy.RWST r w s)
54−instance Monoid w => LiftLocal (Strict.RWST r w s)
55−instance LiftLocal (Lazy.StateT s)
56−instance LiftLocal (Strict.StateT s)
57−instance Monoid w => LiftLocal (Lazy.WriterT w)
58−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