git.iko.soy/typeable/transformers-lift
on master help sign in
Use monad-control for liftListen
commiteb3905a7469f3dfba727299678d4267dbcd7ea39 authorIndex Int <vlad.z.4096@gmail.com> dateSun 21 Jun 2015, 11:00 (11 years ago) parent8864a4e
2 files changed+22−30
compare with master
unifiedsplit
src/Control/Monad/Trans/Lift/Catch.hs+2−1 src/Control/Monad/Trans/Lift/Listen.hs+20−29
src/Control/Monad/Trans/Lift/Catch.hs+2−1
@@ -36,7 +36,8 @@ class MonadTrans t => LiftCatch t where
3636 :: (MonadTransControl t, CatchStT t a ~ StT t a, Monad m, Monad (t m))
3737 => Catch e m (CatchStT t a) -> Catch e (t m) a
3838 liftCatch catch m h = do
39− liftWith (\run -> catch (run m) (run . h)) >>= restoreT . return
39+ st <- liftWith (\run -> catch (run m) (run . h))
40+ restoreT (return st)
4041
4142instance LiftCatch (ExceptT e)
4243instance LiftCatch IdentityT
src/Control/Monad/Trans/Lift/Listen.hs+20−29
@@ -1,6 +1,7 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE TypeFamilies #-}
33{-# LANGUAGE UndecidableInstances #-}
4+{-# LANGUAGE DefaultSignatures #-}
45module Control.Monad.Trans.Lift.Listen
56 ( LiftListen(..)
67 , Listen
@@ -19,6 +20,8 @@ import qualified Control.Monad.Trans.Except as E
1920import qualified Control.Monad.Trans.Identity as I
2021import qualified Control.Monad.Trans.Maybe as M
2122import 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
2225import qualified Control.Monad.Trans.State.Lazy as S.Lazy
2326import qualified Control.Monad.Trans.State.Strict as S.Strict
2427import qualified Control.Monad.Trans.Writer.Lazy as W.Lazy
@@ -28,32 +31,20 @@ class MonadTrans t => LiftListen t where
2831 type ListenStT t a
2932 type ListenStT t a = StT t a
3033 liftListen :: Monad m => Listen w m (ListenStT t a) -> Listen w (t m) a
31− -- TODO: investigate how MonadTransControl can be used for default definition
32−
33−instance LiftListen (E.ExceptT e) where
34− liftListen = E.liftListen
35−
36−instance LiftListen I.IdentityT where
37− liftListen = I.mapIdentityT
38−
39−instance LiftListen M.MaybeT where
40− liftListen = M.liftListen
41−
42−instance LiftListen (R.ReaderT r) where
43− liftListen = R.mapReaderT
44−
45−instance LiftListen (S.Lazy.StateT s) where
46− liftListen = S.Lazy.liftListen
47−
48−instance LiftListen (S.Strict.StateT s) where
49− liftListen = S.Strict.liftListen
50−
51−instance Monoid w' => LiftListen (W.Lazy.WriterT w') where
52− liftListen listen m = W.Lazy.WriterT $ do
53− ~((a, w'), w) <- listen (W.Lazy.runWriterT m)
54− return ((a, w), w')
55−
56−instance Monoid w' => LiftListen (W.Strict.WriterT w') where
57− liftListen listen m = W.Strict.WriterT $ do
58− ((a, w'), w) <- listen (W.Strict.runWriterT m)
59− return ((a, w), w')
34+ default liftListen
35+ :: (MonadTransControl t, ListenStT t a ~ StT t a, Monad m, Monad (t m))
36+ => Listen w m (ListenStT t a) -> Listen w (t m) a
37+ liftListen listen m = do
38+ (st, w) <- liftWith (\run -> listen (run m))
39+ flip (,) w `fmap` restoreT (return st)
40+
41+instance LiftListen (E.ExceptT e)
42+instance LiftListen I.IdentityT
43+instance LiftListen M.MaybeT
44+instance LiftListen (R.ReaderT r)
45+instance LiftListen (S.Lazy.StateT s)
46+instance LiftListen (S.Strict.StateT s)
47+instance Monoid w => LiftListen (RWS.Lazy.RWST r w s) where
48+instance Monoid w => LiftListen (RWS.Strict.RWST r w s) where
49+instance Monoid w => LiftListen (W.Lazy.WriterT w)
50+instance Monoid w => LiftListen (W.Strict.WriterT w)