67ca0b0 · typeable/ether

ether.cabal+1

compare with master

unifiedsplit

@@ -61,6 +61,7 @@ library

61 , transformers-lift >=0.1

62 , mtl >=2.2.1

63 , mmorph >=1.0.4

64+ , monad-control >=1.0.0.4

64 , template-haskell >=2.9

65 , template-haskell >=2.9

65 , newtype-generics >=0.4.1

66 , newtype-generics >=0.4.1

66

67

src/Control/Ether/Util.hs+1−6

@@ -4,8 +4,7 @@

4{-# LANGUAGE TypeOperators #-}

5{-# LANGUAGE TypeFamilies #-}

6module Control.Ether.Util

7− ( liftCatch_ExceptT

8− , liftListen_WriterT

7+ ( liftListen_WriterT

9 , liftPass_WriterT

8 , liftPass_WriterT

10 , type (++)

9 , type (++)

11 , MaybeToList

10 , MaybeToList

@@ -13,7 +12,6 @@ module Control.Ether.Util

13 ) where

12 ) where

14

13

15import qualified Control.Monad.Signatures as Sig

14import qualified Control.Monad.Signatures as Sig

16−import qualified Control.Monad.Trans.Except as Trans

17import qualified Control.Monad.Trans.Writer as Trans

15import qualified Control.Monad.Trans.Writer as Trans

18import Prelude hiding (fmap)

16import Prelude hiding (fmap)

19

17

@@ -31,9 +29,6 @@ type family MaybeToList (mt :: Maybe k) :: [k] where

31 MaybeToList 'Nothing = '[]

29 MaybeToList 'Nothing = '[]

32 MaybeToList ('Just t) = '[t]

30 MaybeToList ('Just t) = '[t]

33

31

34−liftCatch_ExceptT :: Sig.Catch e m (Either e' a) -> Sig.Catch e (Trans.ExceptT e' m) a

35−liftCatch_ExceptT catchE m h = Trans.ExceptT $ catchE (Trans.runExceptT m) (Trans.runExceptT . h)

36−

37-- TODO: Not sure if correct

32-- TODO: Not sure if correct

38liftListen_WriterT :: Monad m => Sig.Listen w' m (a, w) -> Sig.Listen w' (Trans.WriterT w m) a

33liftListen_WriterT :: Monad m => Sig.Listen w' m (a, w) -> Sig.Listen w' (Trans.WriterT w m) a

39liftListen_WriterT listen m = Trans.WriterT $ do

34liftListen_WriterT listen m = Trans.WriterT $ do

src/Control/Monad/Ether/Except/Class.hs+7−79

@@ -20,27 +20,9 @@ module Control.Monad.Ether.Except.Class

20import Data.Monoid

21#endif

22

23−import Data.Proxy (Proxy(Proxy))

24−import Control.Monad.Trans (lift)

25−

26import Control.Monad.Trans.Ether.Except hiding (throw, catch)

23import Control.Monad.Trans.Ether.Except hiding (throw, catch)

27import qualified Control.Monad.Trans.Ether.Except as E

24import qualified Control.Monad.Trans.Ether.Except as E

28−import qualified Control.Monad.Trans.Ether.Reader as R

25+import qualified Control.Monad.Trans.Lift.Catch as Lift

29−import qualified Control.Monad.Trans.Ether.Writer as W

30−import qualified Control.Monad.Trans.Ether.State.Lazy as S.L

31−import qualified Control.Monad.Trans.Ether.State.Strict as S.S

32−import qualified Control.Ether.Util as Util

33−

34−-- for mtl instances

35−import qualified Control.Monad.Trans.Except as Trans.E

36−import qualified Control.Monad.Trans.Identity as Trans.I

37−import qualified Control.Monad.Trans.List as Trans.L

38−import qualified Control.Monad.Trans.Maybe as Trans.M

39−import qualified Control.Monad.Trans.Reader as Trans.R

40−import qualified Control.Monad.Trans.State.Lazy as Trans.S.Lazy

41−import qualified Control.Monad.Trans.State.Strict as Trans.S.Strict

42−import qualified Control.Monad.Trans.Writer.Lazy as Trans.W.Lazy

43−import qualified Control.Monad.Trans.Writer.Strict as Trans.W.Strict

44

26

45

27

46-- | See 'Control.Monad.Except.MonadError'.

28-- | See 'Control.Monad.Except.MonadError'.

@@ -57,63 +39,9 @@ instance {-# OVERLAPPING #-} Monad m => MonadExcept tag e (ExceptT tag e m) wher

57 throw = E.throw

39 throw = E.throw

58 catch = E.catch

40 catch = E.catch

59

41

60−instance MonadExcept tag e m => MonadExcept tag e (ExceptT tag' e' m) where

42+instance ( Lift.LiftCatch t

61− throw t = lift . throw t

43+ , Monad (t m)

62− catch t = liftCatch Proxy (catch t)

44+ , MonadExcept tag e m

63−

64−-- Instances for other tagged transformers

65−

66−instance MonadExcept tag e m => MonadExcept tag e (R.ReaderT tag' r m) where

67− throw t = lift . throw t

68− catch t = R.liftCatch Proxy (catch t)

69−

70−instance (Monoid w, MonadExcept tag e m) => MonadExcept tag e (W.WriterT tag' w m) where

71− throw t = lift . throw t

72− catch t = W.liftCatch Proxy (catch t)

73−

74−instance MonadExcept tag e m => MonadExcept tag e (S.L.StateT tag' s m) where

75− throw t = lift . throw t

76− catch t = S.L.liftCatch Proxy (catch t)

77−

78−instance MonadExcept tag e m => MonadExcept tag e (S.S.StateT tag' s m) where

79− throw t = lift . throw t

80− catch t = S.S.liftCatch Proxy (catch t)

81−

82−

83−-- Instances for mtl transformers

84−

85−instance MonadExcept tag e m => MonadExcept tag e (Trans.E.ExceptT e' m) where

86− throw t = lift . throw t

87− catch t = Util.liftCatch_ExceptT (catch t)

88−

89−instance MonadExcept tag e m => MonadExcept tag e (Trans.I.IdentityT m) where

90− throw t = lift . throw t

91− catch t = Trans.I.liftCatch (catch t)

92−

93−instance MonadExcept tag e m => MonadExcept tag e (Trans.L.ListT m) where

94− throw t = lift . throw t

95− catch t = Trans.L.liftCatch (catch t)

96−

97−instance MonadExcept tag e m => MonadExcept tag e (Trans.M.MaybeT m) where

98− throw t = lift . throw t

99− catch t = Trans.M.liftCatch (catch t)

100−

101−instance MonadExcept tag e m => MonadExcept tag e (Trans.R.ReaderT r m) where

102− throw t = lift . throw t

103− catch t = Trans.R.liftCatch (catch t)

104−

105−instance MonadExcept tag e m => MonadExcept tag e (Trans.S.Lazy.StateT s m) where

106− throw t = lift . throw t

107− catch t = Trans.S.Lazy.liftCatch (catch t)

108−

109−instance MonadExcept tag e m => MonadExcept tag e (Trans.S.Strict.StateT s m) where

110− throw t = lift . throw t

111− catch t = Trans.S.Strict.liftCatch (catch t)

112−

113−instance (Monoid w, MonadExcept tag e m) => MonadExcept tag e (Trans.W.Lazy.WriterT w m) where

45+ ) => MonadExcept tag e (t m) where

114− throw t = lift . throw t

115− catch t = Trans.W.Lazy.liftCatch (catch t)

116−

117−instance (Monoid w, MonadExcept tag e m) => MonadExcept tag e (Trans.W.Strict.WriterT w m) where

118− throw t = lift . throw t

46+ throw t = Lift.lift . throw t

119− catch t = Trans.W.Strict.liftCatch (catch t)

47+ catch t = Lift.liftCatch (catch t)

src/Control/Monad/Trans/Ether/Except.hs+9−7

@@ -26,7 +26,6 @@ module Control.Monad.Trans.Ether.Except

26 , liftCallCC

27 , liftListen

28 , liftPass

29− , liftCatch

30 ) where

29 ) where

31

30

32import Data.Proxy (Proxy(Proxy))

31import Data.Proxy (Proxy(Proxy))

@@ -39,13 +38,14 @@ import Control.Monad.Trans.Class (MonadTrans, lift)

39import Control.Monad.IO.Class (MonadIO)

38import Control.Monad.IO.Class (MonadIO)

40import Control.Monad.Morph (MFunctor, MMonad)

39import Control.Monad.Morph (MFunctor, MMonad)

41import Control.Ether.Tagged (Taggable(..), Tagged(..))

40import Control.Ether.Tagged (Taggable(..), Tagged(..))

42−import qualified Control.Ether.Util as Util

43import GHC.Generics (Generic)

41import GHC.Generics (Generic)

44import qualified Control.Newtype as NT

42import qualified Control.Newtype as NT

45

43

46import qualified Control.Monad.Signatures as Sig

44import qualified Control.Monad.Signatures as Sig

45+import qualified Control.Monad.Trans.Control as MC

47import qualified Control.Monad.Trans.Except as Trans

46import qualified Control.Monad.Trans.Except as Trans

48import qualified Control.Monad.Trans.Lift.Local as Lift

47import qualified Control.Monad.Trans.Lift.Local as Lift

48+import qualified Control.Monad.Trans.Lift.Catch as Lift

49

50import qualified Control.Monad.Cont.Class as Class

51import qualified Control.Monad.Reader.Class as Class

@@ -78,7 +78,13 @@ newtype ExceptT tag e m a = ExceptT (Trans.ExceptT e m a)

78

79instance NT.Newtype (ExceptT tag e m a)

80

81+instance MC.MonadTransControl (ExceptT tag e) where

82+ type StT (ExceptT tag e) a = MC.StT (Trans.ExceptT e) a

83+ liftWith f = ExceptT $ MC.liftWith (f . coerce)

84+ restoreT = ExceptT . MC.restoreT

85+

81instance Lift.LiftLocal (ExceptT tag e)

86instance Lift.LiftLocal (ExceptT tag e)

87+instance Lift.LiftCatch (ExceptT tag e)

82

88

83instance Taggable (ExceptT tag e m) where

89instance Taggable (ExceptT tag e m) where

84 type Tag (ExceptT tag e m) = 'Just tag

90 type Tag (ExceptT tag e m) = 'Just tag

@@ -130,10 +136,6 @@ liftListen t listen m = tagged t $ Trans.liftListen listen (coerce m)

130liftPass :: Monad m => proxy tag -> Sig.Pass w m (Either e a) -> Sig.Pass w (ExceptT tag e m) a

136liftPass :: Monad m => proxy tag -> Sig.Pass w m (Either e a) -> Sig.Pass w (ExceptT tag e m) a

131liftPass t pass m = tagged t $ Trans.liftPass pass (coerce m)

137liftPass t pass m = tagged t $ Trans.liftPass pass (coerce m)

132

138

133−-- | Lift a @catchE@ operation to the new monad.

134−liftCatch :: proxy tag -> Sig.Catch e m (Either e' a) -> Sig.Catch e (ExceptT tag e' m) a

135−liftCatch t catchE m h = tagged t $ Util.liftCatch_ExceptT catchE (coerce m) (coerce h)

136−

137instance Class.MonadCont m => Class.MonadCont (ExceptT tag e m) where

139instance Class.MonadCont m => Class.MonadCont (ExceptT tag e m) where

138 callCC = liftCallCC Proxy Class.callCC

140 callCC = liftCallCC Proxy Class.callCC

139

141

@@ -155,4 +157,4 @@ instance Class.MonadWriter w m => Class.MonadWriter w (ExceptT tag e m) where

155

157

156instance Class.MonadError e' m => Class.MonadError e' (ExceptT tag e m) where

158instance Class.MonadError e' m => Class.MonadError e' (ExceptT tag e m) where

157 throwError = lift . Class.throwError

159 throwError = lift . Class.throwError

158− catchError = liftCatch Proxy Class.catchError

160+ catchError = Lift.liftCatch Class.catchError

src/Control/Monad/Trans/Ether/Reader.hs+8

@@ -42,8 +42,10 @@ import GHC.Generics (Generic)

42import qualified Control.Newtype as NT

43

44import qualified Control.Monad.Signatures as Sig

45+import qualified Control.Monad.Trans.Control as MC

45import qualified Control.Monad.Trans.Reader as Trans

46import qualified Control.Monad.Trans.Reader as Trans

46import qualified Control.Monad.Trans.Lift.Local as Lift

47import qualified Control.Monad.Trans.Lift.Local as Lift

48+import qualified Control.Monad.Trans.Lift.Catch as Lift

47

49

48import qualified Control.Monad.Cont.Class as Class

50import qualified Control.Monad.Cont.Class as Class

49import qualified Control.Monad.Reader.Class as Class

51import qualified Control.Monad.Reader.Class as Class

@@ -71,7 +73,13 @@ newtype ReaderT tag r m a = ReaderT (Trans.ReaderT r m a)

71

73

72instance NT.Newtype (ReaderT tag r m a)

74instance NT.Newtype (ReaderT tag r m a)

73

75

76+instance MC.MonadTransControl (ReaderT tag r) where

77+ type StT (ReaderT tag r) a = MC.StT (Trans.ReaderT r) a

78+ liftWith f = ReaderT $ MC.liftWith (f . coerce)

79+ restoreT = ReaderT . MC.restoreT

80+

74instance Lift.LiftLocal (ReaderT tag r)

81instance Lift.LiftLocal (ReaderT tag r)

82+instance Lift.LiftCatch (ReaderT tag r)

75

83

76instance Taggable (ReaderT tag r m) where

84instance Taggable (ReaderT tag r m) where

77 type Tag (ReaderT tag r m) = 'Just tag

85 type Tag (ReaderT tag r m) = 'Just tag

src/Control/Monad/Trans/Ether/State/Lazy.hs+8

@@ -47,8 +47,10 @@ import GHC.Generics (Generic)

47import qualified Control.Newtype as NT

48

49import qualified Control.Monad.Signatures as Sig

50+import qualified Control.Monad.Trans.Control as MC

50import qualified Control.Monad.Trans.State.Lazy as Trans

51import qualified Control.Monad.Trans.State.Lazy as Trans

51import qualified Control.Monad.Trans.Lift.Local as Lift

52import qualified Control.Monad.Trans.Lift.Local as Lift

53+import qualified Control.Monad.Trans.Lift.Catch as Lift

52

54

53import qualified Control.Monad.Cont.Class as Class

55import qualified Control.Monad.Cont.Class as Class

54import qualified Control.Monad.Reader.Class as Class

56import qualified Control.Monad.Reader.Class as Class

@@ -76,7 +78,13 @@ newtype StateT tag s m a = StateT (Trans.StateT s m a)

76

78

77instance NT.Newtype (StateT tag s m a)

79instance NT.Newtype (StateT tag s m a)

78

80

81+instance MC.MonadTransControl (StateT tag s) where

82+ type StT (StateT tag s) a = MC.StT (Trans.StateT s) a

83+ liftWith f = StateT $ MC.liftWith (f . coerce)

84+ restoreT = StateT . MC.restoreT

85+

79instance Lift.LiftLocal (StateT tag s)

86instance Lift.LiftLocal (StateT tag s)

87+instance Lift.LiftCatch (StateT tag s)

80

88

81instance Taggable (StateT tag s m) where

89instance Taggable (StateT tag s m) where

82 type Tag (StateT tag s m) = 'Just tag

90 type Tag (StateT tag s m) = 'Just tag

src/Control/Monad/Trans/Ether/State/Strict.hs+8

@@ -47,8 +47,10 @@ import GHC.Generics (Generic)

47import qualified Control.Newtype as NT

48

49import qualified Control.Monad.Signatures as Sig

50+import qualified Control.Monad.Trans.Control as MC

50import qualified Control.Monad.Trans.State.Strict as Trans

51import qualified Control.Monad.Trans.State.Strict as Trans

51import qualified Control.Monad.Trans.Lift.Local as Lift

52import qualified Control.Monad.Trans.Lift.Local as Lift

53+import qualified Control.Monad.Trans.Lift.Catch as Lift

52

54

53import qualified Control.Monad.Cont.Class as Class

55import qualified Control.Monad.Cont.Class as Class

54import qualified Control.Monad.Reader.Class as Class

56import qualified Control.Monad.Reader.Class as Class

@@ -76,7 +78,13 @@ newtype StateT tag s m a = StateT (Trans.StateT s m a)

76

78

77instance NT.Newtype (StateT tag s m a)

79instance NT.Newtype (StateT tag s m a)

78

80

81+instance MC.MonadTransControl (StateT tag s) where

82+ type StT (StateT tag s) a = MC.StT (Trans.StateT s) a

83+ liftWith f = StateT $ MC.liftWith (f . coerce)

84+ restoreT = StateT . MC.restoreT

85+

79instance Lift.LiftLocal (StateT tag s)

86instance Lift.LiftLocal (StateT tag s)

87+instance Lift.LiftCatch (StateT tag s)

80

88

81instance Taggable (StateT tag s m) where

89instance Taggable (StateT tag s m) where

82 type Tag (StateT tag s m) = 'Just tag

90 type Tag (StateT tag s m) = 'Just tag

src/Control/Monad/Trans/Ether/Writer.hs+8

@@ -52,8 +52,10 @@ import GHC.Generics (Generic)

52import qualified Control.Newtype as NT

53

54import qualified Control.Monad.Signatures as Sig

55+import qualified Control.Monad.Trans.Control as MC

55import qualified Control.Monad.Trans.Writer.Lazy as Trans

56import qualified Control.Monad.Trans.Writer.Lazy as Trans

56import qualified Control.Monad.Trans.Lift.Local as Lift

57import qualified Control.Monad.Trans.Lift.Local as Lift

58+import qualified Control.Monad.Trans.Lift.Catch as Lift

57

59

58import qualified Control.Monad.Cont.Class as Class

60import qualified Control.Monad.Cont.Class as Class

59import qualified Control.Monad.Reader.Class as Class

61import qualified Control.Monad.Reader.Class as Class

@@ -80,7 +82,13 @@ newtype WriterT tag w m a = WriterT (Trans.WriterT w m a)

80

82

81instance NT.Newtype (WriterT tag w m a)

83instance NT.Newtype (WriterT tag w m a)

82

84

85+instance Monoid w => MC.MonadTransControl (WriterT tag w) where

86+ type StT (WriterT tag w) a = MC.StT (Trans.WriterT w) a

87+ liftWith f = WriterT $ MC.liftWith (f . coerce)

88+ restoreT = WriterT . MC.restoreT

89+

83instance Monoid w => Lift.LiftLocal (WriterT tag w)

90instance Monoid w => Lift.LiftLocal (WriterT tag w)

91+instance Monoid w => Lift.LiftCatch (WriterT tag w)

84

92

85instance Taggable (WriterT tag w m) where

93instance Taggable (WriterT tag w m) where

86 type Tag (WriterT tag w m) = 'Just tag

94 type Tag (WriterT tag w m) = 'Just tag