e0731a7 · typeable/ether

git.iko.soy/typeable/ether

on master help sign in

Explicit liftLocal

e0731a7Index Int11 years ago

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

compare with master

unifiedsplit

@@ -37,6 +37,7 @@ import qualified Control.Newtype as NT

37import qualified Control.Monad.Trans.Control as MC

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

40+import qualified Control.Monad.Trans.Lift.StT as Lift

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

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

41import qualified Control.Monad.Trans.Lift.Catch as Lift

42import qualified Control.Monad.Trans.Lift.Catch as Lift

42import qualified Control.Monad.Trans.Lift.Listen as Lift

43import qualified Control.Monad.Trans.Lift.Listen as Lift

@@ -66,8 +67,7 @@ runExcept t = Trans.runExcept . untagged t

66--

67--

67-- The 'return' function returns a normal value, while '>>=' exits on

68-- The 'return' function returns a normal value, while '>>=' exits on

68-- the first exception.

69-- the first exception.

69−

70−newtype ExceptT tag e m a = ET { runET :: Trans.ExceptT e m a }

70+newtype ExceptT tag e m a = ExceptT (Trans.ExceptT e m a)

71 deriving ( Generic

72 , Functor, Applicative, Alternative, Monad, MonadPlus

73 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )

@@ -76,18 +76,26 @@ instance NT.Newtype (ExceptT tag e m a)

77instance MC.MonadTransControl (ExceptT tag e) where

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

79− liftWith = MC.defaultLiftWith ET runET

79+ liftWith = MC.defaultLiftWith NT.pack NT.unpack

80− restoreT = MC.defaultRestoreT ET

80+ restoreT = MC.defaultRestoreT NT.pack

81+

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

83+

84+instance Lift.LiftLocal (ExceptT tag e) where

85+ liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack

86+

87+instance Lift.LiftCatch (ExceptT tag e) where

88+ liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack

82−instance Lift.LiftLocal (ExceptT tag e)

83−instance Lift.LiftCatch (ExceptT tag e)

84−instance Lift.LiftListen (ExceptT tag e)

90+instance Lift.LiftListen (ExceptT tag e) where

91+ liftListen = Lift.defaultLiftListen NT.pack NT.unpack

86instance Lift.LiftPass (ExceptT tag e) where

93instance Lift.LiftPass (ExceptT tag e) where

87− liftPass pass m = ET $ Lift.liftPass pass (runET m)

94+ liftPass = Lift.defaultLiftPass NT.pack NT.unpack

89instance Lift.LiftCallCC (ExceptT tag e) where

96instance Lift.LiftCallCC (ExceptT tag e) where

90− liftCallCC callCC f = ET $ Lift.liftCallCC callCC (\g -> (runET . f) (ET . g))

97+ liftCallCC = Lift.defaultLiftCallCC NT.pack NT.unpack

98+ liftCallCC' = Lift.defaultLiftCallCC NT.pack NT.unpack

92instance Taggable (ExceptT tag e m) where

100instance Taggable (ExceptT tag e m) where

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

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

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

@@ -37,6 +37,7 @@ import qualified Control.Newtype as NT

37import qualified Control.Monad.Trans.Control as MC

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

40+import qualified Control.Monad.Trans.Lift.StT as Lift

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

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

41import qualified Control.Monad.Trans.Lift.Catch as Lift

42import qualified Control.Monad.Trans.Lift.Catch as Lift

42import qualified Control.Monad.Trans.Lift.Listen as Lift

43import qualified Control.Monad.Trans.Lift.Listen as Lift

@@ -62,7 +63,7 @@ type Reader tag r = ReaderT tag r Identity

62--

63--

63-- The 'return' function ignores the environment, while '>>=' passes

64-- The 'return' function ignores the environment, while '>>=' passes

64-- the inherited environment to both subcomputations.

65-- the inherited environment to both subcomputations.

65−newtype ReaderT tag r m a = RT { runRT :: Trans.ReaderT r m a }

66+newtype ReaderT tag r m a = ReaderT (Trans.ReaderT r m a)

66 deriving ( Generic

67 deriving ( Generic

67 , Functor, Applicative, Alternative, Monad, MonadPlus

68 , Functor, Applicative, Alternative, Monad, MonadPlus

68 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )

69 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )

@@ -71,18 +72,26 @@ instance NT.Newtype (ReaderT tag r m a)

72instance MC.MonadTransControl (ReaderT tag r) where

73instance MC.MonadTransControl (ReaderT tag r) where

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

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

74− liftWith = MC.defaultLiftWith RT runRT

75+ liftWith = MC.defaultLiftWith NT.pack NT.unpack

75− restoreT = MC.defaultRestoreT RT

76+ restoreT = MC.defaultRestoreT NT.pack

78+type instance Lift.StT (ReaderT tag r) a = MC.StT (ReaderT tag r) a

79+

77−instance Lift.LiftLocal (ReaderT tag r)

80+instance Lift.LiftLocal (ReaderT tag r) where

81+ liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack

82+

78−instance Lift.LiftCatch (ReaderT tag r)

83+instance Lift.LiftCatch (ReaderT tag r) where

84+ liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack

85+

79−instance Lift.LiftListen (ReaderT tag r)

86+instance Lift.LiftListen (ReaderT tag r) where

87+ liftListen = Lift.defaultLiftListen NT.pack NT.unpack

81instance Lift.LiftPass (ReaderT tag r) where

89instance Lift.LiftPass (ReaderT tag r) where

82− liftPass pass m = RT $ Lift.liftPass pass (runRT m)

90+ liftPass = Lift.defaultLiftPass NT.pack NT.unpack

84instance Lift.LiftCallCC (ReaderT tag r) where

92instance Lift.LiftCallCC (ReaderT tag r) where

85− liftCallCC callCC f = RT $ Lift.liftCallCC callCC (\g -> (runRT . f) (RT . g))

93+ liftCallCC = Lift.defaultLiftCallCC NT.pack NT.unpack

94+ liftCallCC' = Lift.defaultLiftCallCC' NT.pack NT.unpack

87instance Taggable (ReaderT tag r m) where

96instance Taggable (ReaderT tag r m) where

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

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

src/Control/Monad/Trans/Ether/State/Lazy.hs+17−9

@@ -41,6 +41,7 @@ import qualified Control.Newtype as NT

41import qualified Control.Monad.Trans.Control as MC

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

44+import qualified Control.Monad.Trans.Lift.StT as Lift

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

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

45import qualified Control.Monad.Trans.Lift.Catch as Lift

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

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

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

@@ -66,7 +67,7 @@ type State tag r = StateT tag r Identity

66--

67--

67-- The 'return' function leaves the state unchanged, while '>>=' uses

68-- The 'return' function leaves the state unchanged, while '>>=' uses

68-- the final state of the first computation as the initial state of the second.

69-- the final state of the first computation as the initial state of the second.

69−newtype StateT tag s m a = ST { runST :: Trans.StateT s m a }

70+newtype StateT tag s m a = StateT (Trans.StateT s m a)

70 deriving ( Generic

71 deriving ( Generic

71 , Functor, Applicative, Alternative, Monad, MonadPlus

72 , Functor, Applicative, Alternative, Monad, MonadPlus

72 , MonadFix, MonadTrans, MonadIO, MFunctor )

73 , MonadFix, MonadTrans, MonadIO, MFunctor )

@@ -75,19 +76,26 @@ instance NT.Newtype (StateT tag s m a)

76instance MC.MonadTransControl (StateT tag s) where

77instance MC.MonadTransControl (StateT tag s) where

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

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

78− liftWith = MC.defaultLiftWith ST runST

79+ liftWith = MC.defaultLiftWith NT.pack NT.unpack

79− restoreT = MC.defaultRestoreT ST

80+ restoreT = MC.defaultRestoreT NT.pack

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

83+

81−instance Lift.LiftLocal (StateT tag s)

84+instance Lift.LiftLocal (StateT tag s) where

85+ liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack

86+

82−instance Lift.LiftCatch (StateT tag s)

87+instance Lift.LiftCatch (StateT tag s) where

88+ liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack

89+

83−instance Lift.LiftListen (StateT tag s)

90+instance Lift.LiftListen (StateT tag s) where

91+ liftListen = Lift.defaultLiftListen NT.pack NT.unpack

85instance Lift.LiftPass (StateT tag s) where

93instance Lift.LiftPass (StateT tag s) where

86− liftPass pass m = ST $ Lift.liftPass pass (runST m)

94+ liftPass = Lift.defaultLiftPass NT.pack NT.unpack

88instance Lift.LiftCallCC (StateT tag s) where

96instance Lift.LiftCallCC (StateT tag s) where

89− liftCallCC callCC f = ST $ Lift.liftCallCC callCC (\g -> (runST . f) (ST . g))

97+ liftCallCC = Lift.defaultLiftCallCC NT.pack NT.unpack

90− liftCallCC' callCC f = ST $ Lift.liftCallCC' callCC (\g -> (runST . f) (ST . g))

98+ liftCallCC' = Lift.defaultLiftCallCC' NT.pack NT.unpack

92instance Taggable (StateT tag s m) where

100instance Taggable (StateT tag s m) where

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

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

src/Control/Monad/Trans/Ether/State/Strict.hs+17−9

@@ -41,6 +41,7 @@ import qualified Control.Newtype as NT

41import qualified Control.Monad.Trans.Control as MC

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

44+import qualified Control.Monad.Trans.Lift.StT as Lift

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

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

45import qualified Control.Monad.Trans.Lift.Catch as Lift

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

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

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

@@ -66,7 +67,7 @@ type State tag r = StateT tag r Identity

66--

67--

67-- The 'return' function leaves the state unchanged, while '>>=' uses

68-- The 'return' function leaves the state unchanged, while '>>=' uses

68-- the final state of the first computation as the initial state of the second.

69-- the final state of the first computation as the initial state of the second.

69−newtype StateT tag s m a = ST { runST :: Trans.StateT s m a }

70+newtype StateT tag s m a = StateT (Trans.StateT s m a)

70 deriving ( Generic

71 deriving ( Generic

71 , Functor, Applicative, Alternative, Monad, MonadPlus

72 , Functor, Applicative, Alternative, Monad, MonadPlus

72 , MonadFix, MonadTrans, MonadIO, MFunctor )

73 , MonadFix, MonadTrans, MonadIO, MFunctor )

@@ -75,19 +76,26 @@ instance NT.Newtype (StateT tag s m a)

76instance MC.MonadTransControl (StateT tag s) where

77instance MC.MonadTransControl (StateT tag s) where

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

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

78− liftWith = MC.defaultLiftWith ST runST

79+ liftWith = MC.defaultLiftWith NT.pack NT.unpack

79− restoreT = MC.defaultRestoreT ST

80+ restoreT = MC.defaultRestoreT NT.pack

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

83+

81−instance Lift.LiftLocal (StateT tag s)

84+instance Lift.LiftLocal (StateT tag s) where

85+ liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack

86+

82−instance Lift.LiftCatch (StateT tag s)

87+instance Lift.LiftCatch (StateT tag s) where

88+ liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack

89+

83−instance Lift.LiftListen (StateT tag s)

90+instance Lift.LiftListen (StateT tag s) where

91+ liftListen = Lift.defaultLiftListen NT.pack NT.unpack

85instance Lift.LiftPass (StateT tag s) where

93instance Lift.LiftPass (StateT tag s) where

86− liftPass pass m = ST $ Lift.liftPass pass (runST m)

94+ liftPass = Lift.defaultLiftPass NT.pack NT.unpack

88instance Lift.LiftCallCC (StateT tag s) where

96instance Lift.LiftCallCC (StateT tag s) where

89− liftCallCC callCC f = ST $ Lift.liftCallCC callCC (\g -> (runST . f) (ST . g))

97+ liftCallCC = Lift.defaultLiftCallCC NT.pack NT.unpack

90− liftCallCC' callCC f = ST $ Lift.liftCallCC' callCC (\g -> (runST . f) (ST . g))

98+ liftCallCC' = Lift.defaultLiftCallCC' NT.pack NT.unpack

92instance Taggable (StateT tag s m) where

100instance Taggable (StateT tag s m) where

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

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

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

@@ -45,6 +45,7 @@ import qualified Control.Newtype as NT

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

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

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

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

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

49import qualified Control.Monad.Trans.Lift.Catch as Lift

50import qualified Control.Monad.Trans.Lift.Catch as Lift

50import qualified Control.Monad.Trans.Lift.Listen as Lift

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

@@ -69,7 +70,7 @@ type Writer tag w = WriterT tag w Identity

69--

70--

70-- The 'return' function produces the output 'mempty', while '>>=' combines

71-- The 'return' function produces the output 'mempty', while '>>=' combines

71-- the outputs of the subcomputations using 'mappend'.

72-- the outputs of the subcomputations using 'mappend'.

72−newtype WriterT tag w m a = WT { runWT :: Trans.WriterT w m a }

73+newtype WriterT tag w m a = WriterT (Trans.WriterT w m a)

73 deriving ( Generic

74 deriving ( Generic

74 , Functor, Applicative, Alternative, Monad, MonadPlus

75 , Functor, Applicative, Alternative, Monad, MonadPlus

75 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )

76 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )

@@ -78,18 +79,26 @@ instance NT.Newtype (WriterT tag w m a)

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

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

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

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

81− liftWith = MC.defaultLiftWith WT runWT

82+ liftWith = MC.defaultLiftWith NT.pack NT.unpack

82− restoreT = MC.defaultRestoreT WT

83+ restoreT = MC.defaultRestoreT NT.pack

85+type instance Lift.StT (WriterT tag w) a = MC.StT (WriterT tag w) a

86+

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

87+instance Monoid w => Lift.LiftLocal (WriterT tag w) where

88+ liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack

89+

85−instance Monoid w => Lift.LiftCatch (WriterT tag w)

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

91+ liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack

92+

86−instance Monoid w => Lift.LiftListen (WriterT tag w)

93+instance Monoid w => Lift.LiftListen (WriterT tag w) where

94+ liftListen = Lift.defaultLiftListen NT.pack NT.unpack

88instance Monoid w' => Lift.LiftPass (WriterT tag w') where

96instance Monoid w' => Lift.LiftPass (WriterT tag w') where

89− liftPass pass' m = WT $ Lift.liftPass pass' (runWT m)

97+ liftPass = Lift.defaultLiftPass NT.pack NT.unpack

91instance Monoid w => Lift.LiftCallCC (WriterT tag w) where

99instance Monoid w => Lift.LiftCallCC (WriterT tag w) where

92− liftCallCC callCC f = WT $ Lift.liftCallCC callCC (\g -> (runWT . f) (WT . g))

100+ liftCallCC = Lift.defaultLiftCallCC WT runWT

101+ liftCallCC' = Lift.defaultLiftCallCC WT runWT

102

94instance Taggable (WriterT tag w m) where

103instance Taggable (WriterT tag w m) where

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

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