eb3905a · typeable/transformers-lift

git.iko.soy/typeable/transformers-lift

on master help sign in

Use monad-control for liftListen

eb3905aIndex Int11 years ago

src/Control/Monad/Trans/Lift/Catch.hs+2−1

compare with master

unifiedsplit

@@ -36,7 +36,8 @@ class MonadTrans t => LiftCatch t where

36 :: (MonadTransControl t, CatchStT t a ~ StT t a, Monad m, Monad (t m))

37 => Catch e m (CatchStT t a) -> Catch e (t m) a

38 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)

41instance LiftCatch (ExceptT e)

42instance LiftCatch (ExceptT e)

42instance LiftCatch IdentityT

43instance LiftCatch IdentityT

src/Control/Monad/Trans/Lift/Listen.hs+20−29

@@ -1,6 +1,7 @@

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE TypeFamilies #-}

3{-# LANGUAGE UndecidableInstances #-}

4+{-# LANGUAGE DefaultSignatures #-}

4module Control.Monad.Trans.Lift.Listen

5module Control.Monad.Trans.Lift.Listen

5 ( LiftListen(..)

6 ( LiftListen(..)

6 , Listen

7 , Listen

@@ -19,6 +20,8 @@ import qualified Control.Monad.Trans.Except as E

19import qualified Control.Monad.Trans.Identity as I

20import qualified Control.Monad.Trans.Identity as I

20import qualified Control.Monad.Trans.Maybe as M

21import qualified Control.Monad.Trans.Maybe as M

21import qualified Control.Monad.Trans.Reader as R

22import 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

22import qualified Control.Monad.Trans.State.Lazy as S.Lazy

25import qualified Control.Monad.Trans.State.Lazy as S.Lazy

23import qualified Control.Monad.Trans.State.Strict as S.Strict

26import qualified Control.Monad.Trans.State.Strict as S.Strict

24import qualified Control.Monad.Trans.Writer.Lazy as W.Lazy

27import qualified Control.Monad.Trans.Writer.Lazy as W.Lazy

@@ -28,32 +31,20 @@ class MonadTrans t => LiftListen t where

28 type ListenStT t a

31 type ListenStT t a

29 type ListenStT t a = StT t a

32 type ListenStT t a = StT t a

30 liftListen :: Monad m => Listen w m (ListenStT t a) -> Listen w (t m) a

33 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

34+ default liftListen

32−

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+

33−instance LiftListen (E.ExceptT e) where

41+instance LiftListen (E.ExceptT e)

34− liftListen = E.liftListen

35−

36−instance LiftListen I.IdentityT where

42+instance LiftListen I.IdentityT

37− liftListen = I.mapIdentityT

38−

39−instance LiftListen M.MaybeT where

43+instance LiftListen M.MaybeT

40− liftListen = M.liftListen

41−

42−instance LiftListen (R.ReaderT r) where

44+instance LiftListen (R.ReaderT r)

43− liftListen = R.mapReaderT

44−

45−instance LiftListen (S.Lazy.StateT s) where

45+instance LiftListen (S.Lazy.StateT s)

46− liftListen = S.Lazy.liftListen

47−

48−instance LiftListen (S.Strict.StateT s) where

46+instance LiftListen (S.Strict.StateT s)

49− liftListen = S.Strict.liftListen

50−

51−instance Monoid w' => LiftListen (W.Lazy.WriterT w') where

47+instance Monoid w => LiftListen (RWS.Lazy.RWST r w s) where

52− liftListen listen m = W.Lazy.WriterT $ do

48+instance Monoid w => LiftListen (RWS.Strict.RWST r w s) where

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

49+instance Monoid w => LiftListen (W.Lazy.WriterT w)

57− liftListen listen m = W.Strict.WriterT $ do

50+instance Monoid w => LiftListen (W.Strict.WriterT w)

58− ((a, w'), w) <- listen (W.Strict.runWriterT m)

59− return ((a, w), w')