4e98fe4 · typeable/ether

git.iko.soy/typeable/ether

Refactor operations

commit4e98fe4f718dccdcc78a2c27620ac886649bab13 authorIndex Int <vlad.z.4096@gmail.com> dateFri 12 Jun 2015, 19:03 (11 years ago) parent3e0c17e

9 files changed+257−145

compare with master

unifiedsplit

ether.cabal+2 src/Control/Ether/Util.hs+9 src/Control/Monad/Ether/Except.hs+28−30 src/Control/Monad/Ether/Implicit/State.hs+2−3 src/Control/Monad/Ether/Reader.hs+33−31 src/Control/Monad/Ether/State.hs+51−49 src/Control/Monad/Trans/Ether/Except.hs+34−9 src/Control/Monad/Trans/Ether/Reader.hs+55−6 src/Control/Monad/Trans/Ether/State.hs+43−17

ether.cabal+2

@@ -37,6 +37,8 @@ library

3737 Control.Monad.Ether.Implicit.Except

3838 Control.Monad.Ether.Implicit.Except.TH

3939

40+ other-modules: Control.Ether.Util

41+

4042 build-depends: base >=4.8 && <4.9

4143 , transformers >=0.4.0.3

4244 , mtl >=2.2.1

src/Control/Ether/Util.hsnew file+9

@@ -0,0 +1,9 @@

1+module Control.Ether.Util

2+ ( liftCatch_ExceptT

3+ ) where

5+import qualified Control.Monad.Signatures as Sig

6+import qualified Control.Monad.Trans.Except as Trans

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

9+liftCatch_ExceptT catchE m h = Trans.ExceptT $ catchE (Trans.runExceptT m) (Trans.runExceptT . h)

src/Control/Monad/Ether/Except.hs+28−30

@@ -29,7 +29,8 @@ import Control.Monad.Trans (lift)

2929

3030import qualified Control.Monad.Trans.Ether.Reader as Reader

3131import qualified Control.Monad.Trans.Ether.State as State

32−import Control.Monad.Trans.Ether.Except

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

33+import qualified Control.Monad.Trans.Ether.Except as E

3334

3435-- for mtl instances

3536import qualified Control.Monad.Trans.Except as Trans (ExceptT(..), runExceptT)

@@ -52,61 +53,58 @@ class Monad m => MonadExcept tag e m | m tag -> e where

5253 catch :: proxy tag -> m a -> (e -> m a) -> m a

5354

5455instance {-# OVERLAPPING #-} Monad m => MonadExcept tag e (ExceptT tag e m) where

55− throw proxy = exceptT proxy . return . Left

56− catch proxy m h

57− = exceptT proxy

58− $ runExceptT proxy m

59− >>= either (runExceptT proxy . h) (return . Right)

56+ throw = E.throw

57+ catch = E.catch

6058

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

62− throw proxy = lift . throw proxy

63− catch proxy = liftCatch Proxy (catch proxy)

60+ throw t = lift . throw t

61+ catch t = liftCatch Proxy (catch t)

6462

6563-- Instances for other tagged transformers

6664

6765instance MonadExcept tag e m => MonadExcept tag e (Reader.ReaderT tag' r m) where

68− throw proxy = lift . throw proxy

69− catch proxy = Reader.liftCatch Proxy (catch proxy)

66+ throw t = lift . throw t

67+ catch t = Reader.liftCatch Proxy (catch t)

7068

7169instance MonadExcept tag e m => MonadExcept tag e (State.StateT tag' s m) where

72− throw proxy = lift . throw proxy

73− catch proxy = State.liftCatch Proxy (catch proxy)

70+ throw t = lift . throw t

71+ catch t = State.liftCatch Proxy (catch t)

7472

7573

7674-- Instances for mtl transformers

7775

7876instance MonadExcept tag e m => MonadExcept tag e (Trans.ExceptT e' m) where

79− throw proxy = lift . throw proxy

80− catch proxy m h = Trans.ExceptT $ catch proxy (Trans.runExceptT m) (Trans.runExceptT . h)

77+ throw t = lift . throw t

78+ catch t m h = Trans.ExceptT $ catch t (Trans.runExceptT m) (Trans.runExceptT . h)

8179

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

83− throw proxy = lift . throw proxy

84− catch proxy = Trans.I.liftCatch (catch proxy)

81+ throw t = lift . throw t

82+ catch t = Trans.I.liftCatch (catch t)

8583

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

87− throw proxy = lift . throw proxy

88− catch proxy = Trans.L.liftCatch (catch proxy)

85+ throw t = lift . throw t

86+ catch t = Trans.L.liftCatch (catch t)

8987

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

91− throw proxy = lift . throw proxy

92− catch proxy = Trans.M.liftCatch (catch proxy)

89+ throw t = lift . throw t

90+ catch t = Trans.M.liftCatch (catch t)

9391

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

95− throw proxy = lift . throw proxy

96− catch proxy = Trans.R.liftCatch (catch proxy)

93+ throw t = lift . throw t

94+ catch t = Trans.R.liftCatch (catch t)

9795

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

99− throw proxy = lift . throw proxy

100− catch proxy = Trans.S.Lazy.liftCatch (catch proxy)

97+ throw t = lift . throw t

98+ catch t = Trans.S.Lazy.liftCatch (catch t)

10199

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

103− throw proxy = lift . throw proxy

104− catch proxy = Trans.S.Strict.liftCatch (catch proxy)

101+ throw t = lift . throw t

102+ catch t = Trans.S.Strict.liftCatch (catch t)

105103

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

107− throw proxy = lift . throw proxy

108− catch proxy = Trans.W.Lazy.liftCatch (catch proxy)

105+ throw t = lift . throw t

106+ catch t = Trans.W.Lazy.liftCatch (catch t)

109107

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

111− throw proxy = lift . throw proxy

112− catch proxy = Trans.W.Strict.liftCatch (catch proxy)

109+ throw t = lift . throw t

110+ catch t = Trans.W.Strict.liftCatch (catch t)

src/Control/Monad/Ether/Implicit/State.hs+2−3

@@ -30,13 +30,13 @@ runStateT = Explicit.runStateT Proxy

3030runState :: State s a -> s -> (a, s)

3131runState = Explicit.runState Proxy

3232

33−evalStateT :: Functor m => StateT s m a -> s -> m a

33+evalStateT :: Monad m => StateT s m a -> s -> m a

3434evalStateT = Explicit.evalStateT Proxy

3535

3636evalState :: State s a -> s -> a

3737evalState = Explicit.evalState Proxy

3838

39−execStateT :: Functor m => StateT s m a -> s -> m s

39+execStateT :: Monad m => StateT s m a -> s -> m s

4040execStateT = Explicit.execStateT Proxy

4141

4242execState :: State s a -> s -> s

@@ -58,4 +58,3 @@ state = Explicit.state (Proxy :: Proxy s)

5858

5959modify :: forall m s . MonadState s m => (s -> s) -> m ()

6060modify = Explicit.modify (Proxy :: Proxy s)

61−

src/Control/Monad/Ether/Reader.hs+33−31

@@ -30,7 +30,8 @@ import Control.Monad.Trans (lift)

3030

3131import Control.Monad.Trans.Ether.State (StateT , mapStateT)

3232import Control.Monad.Trans.Ether.Except (ExceptT, mapExceptT)

33−import Control.Monad.Trans.Ether.Reader

33+import Control.Monad.Trans.Ether.Reader hiding (reader, ask, local)

34+import qualified Control.Monad.Trans.Ether.Reader as R

3435

3536-- for mtl instances

3637import qualified Control.Monad.Trans.Cont as Trans (ContT , liftLocal)

@@ -50,7 +51,7 @@ class Monad m => MonadReader tag r m | m tag -> r where

5051

5152 -- | Retrieves the monad environment.

5253 ask :: proxy tag -> m r

53− ask proxy = reader proxy id

54+ ask t = reader t id

5455

5556 -- | Executes a computation in a modified environment.

5657 local

@@ -67,7 +68,7 @@ class Monad m => MonadReader tag r m | m tag -> r where

6768 -> (r -> a)

6869 -- ^ The selector function to apply to the environment.

6970 -> m a

70− reader proxy f = fmap f (ask proxy)

71+ reader t f = fmap f (ask t)

7172

7273-- | Retrieves a function of the current environment.

7374asks

@@ -79,61 +80,62 @@ asks

7980asks = reader

8081

8182instance {-# OVERLAPPING #-} Monad m => MonadReader tag r (ReaderT tag r m) where

82− ask proxy = readerT proxy return

83− local proxy f m = readerT proxy (runReaderT proxy m . f)

83+ ask = R.ask

84+ local = R.local

85+ reader = R.reader

8486

8587instance MonadReader tag r m => MonadReader tag r (ReaderT tag' r' m) where

86− ask proxy = lift (ask proxy)

87− local proxy = mapReaderT Proxy . local proxy

88+ ask t = lift (ask t)

89+ local t = mapReaderT Proxy . local t

8890

8991-- Instances for other tagged transformers

9092

9193instance (MonadReader tag r m) => MonadReader tag r (StateT tag' s m) where

92− ask proxy = lift (ask proxy)

93− local proxy = mapStateT Proxy . local proxy

94+ ask t = lift (ask t)

95+ local t = mapStateT Proxy . local t

9496

9597instance (MonadReader tag r m) => MonadReader tag r (ExceptT tag' e m) where

96− ask proxy = lift (ask proxy)

97− local proxy = mapExceptT Proxy . local proxy

98+ ask t = lift (ask t)

99+ local t = mapExceptT Proxy . local t

98100

99101-- Instances for mtl transformers

100102

101103instance MonadReader tag r m => MonadReader tag r (Trans.ContT r' m) where

102− ask proxy = lift (ask proxy)

103− local proxy = Trans.liftLocal (ask proxy) (local proxy)

104+ ask t = lift (ask t)

105+ local t = Trans.liftLocal (ask t) (local t)

104106

105107instance MonadReader tag r m => MonadReader tag r (Trans.ExceptT e m) where

106− ask proxy = lift (ask proxy)

107− local proxy = Trans.mapExceptT . local proxy

108+ ask t = lift (ask t)

109+ local t = Trans.mapExceptT . local t

108110

109111instance MonadReader tag r m => MonadReader tag r (Trans.IdentityT m) where

110− ask proxy = lift (ask proxy)

111− local proxy = Trans.mapIdentityT . local proxy

112+ ask t = lift (ask t)

113+ local t = Trans.mapIdentityT . local t

112114

113115instance MonadReader tag r m => MonadReader tag r (Trans.ListT m) where

114− ask proxy = lift (ask proxy)

115− local proxy = Trans.mapListT . local proxy

116+ ask t = lift (ask t)

117+ local t = Trans.mapListT . local t

116118

117119instance MonadReader tag r m => MonadReader tag r (Trans.MaybeT m) where

118− ask proxy = lift (ask proxy)

119− local proxy = Trans.mapMaybeT . local proxy

120+ ask t = lift (ask t)

121+ local t = Trans.mapMaybeT . local t

120122

121123instance MonadReader tag r m => MonadReader tag r (Trans.ReaderT r' m) where

122− ask proxy = lift (ask proxy)

123− local proxy = Trans.mapReaderT . local proxy

124+ ask t = lift (ask t)

125+ local t = Trans.mapReaderT . local t

124126

125127instance MonadReader tag r m => MonadReader tag r (Trans.Lazy.StateT s m) where

126− ask proxy = lift (ask proxy)

127− local proxy = Trans.Lazy.mapStateT . local proxy

128+ ask t = lift (ask t)

129+ local t = Trans.Lazy.mapStateT . local t

128130

129131instance MonadReader tag r m => MonadReader tag r (Trans.Strict.StateT s m) where

130− ask proxy = lift (ask proxy)

131− local proxy = Trans.Strict.mapStateT . local proxy

132+ ask t = lift (ask t)

133+ local t = Trans.Strict.mapStateT . local t

132134

133135instance (Monoid w, MonadReader tag r m) => MonadReader tag r (Trans.Lazy.WriterT w m) where

134− ask proxy = lift (ask proxy)

135− local proxy = Trans.Lazy.mapWriterT . local proxy

136+ ask t = lift (ask t)

137+ local t = Trans.Lazy.mapWriterT . local t

136138

137139instance (Monoid w, MonadReader tag r m) => MonadReader tag r (Trans.Strict.WriterT w m) where

138− ask proxy = lift (ask proxy)

139− local proxy = Trans.Strict.mapWriterT . local proxy

140+ ask t = lift (ask t)

141+ local t = Trans.Strict.mapWriterT . local t

src/Control/Monad/Ether/State.hs+51−49

@@ -34,7 +34,8 @@ import Control.Monad.Trans (lift)

3434

3535import Control.Monad.Trans.Ether.Reader (ReaderT)

3636import Control.Monad.Trans.Ether.Except (ExceptT)

37−import Control.Monad.Trans.Ether.State

37+import Control.Monad.Trans.Ether.State hiding (state, get, put)

38+import qualified Control.Monad.Trans.Ether.State as S

3839

3940-- for mtl instances

4041import qualified Control.Monad.Trans.Cont as Trans (ContT)

@@ -54,97 +55,98 @@ class Monad m => MonadState tag s m | m tag -> s where

5455

5556 -- | Return the state from the internals of the monad.

5657 get :: proxy tag -> m s

57− get proxy = state proxy (\s -> (s, s))

58+ get t = state t (\s -> (s, s))

5859

5960 -- | Replace the state inside the monad.

6061 put :: proxy tag -> s -> m ()

61− put proxy s = state proxy (\_ -> ((), s))

62+ put t s = state t (\_ -> ((), s))

6263

6364 -- | Embed a simple state action into the monad.

6465 state :: proxy tag -> (s -> (a, s)) -> m a

65− state proxy f = do

66− s <- get proxy

66+ state t f = do

67+ s <- get t

6768 let ~(a, s') = f s

68− put proxy s'

69+ put t s'

6970 return a

7071

7172-- | Modifies the state inside a state monad.

7273modify :: MonadState tag s m => proxy tag -> (s -> s) -> m ()

73−modify proxy f = state proxy $ \ s -> ((), f s)

74+modify t f = state t (\s -> ((), f s))

7475

7576-- | Gets specific component of the state, using a projection function supplied.

7677gets :: MonadState tag s m => proxy tag -> (s -> a) -> m a

77−gets proxy f = fmap f (get proxy)

78+gets t f = fmap f (get t)

7879

7980instance {-# OVERLAPPING #-} Monad m => MonadState tag s (StateT tag s m) where

80− get proxy = stateT proxy (\s -> return (s, s))

81− put proxy s = stateT proxy (\_ -> return ((), s))

81+ get = S.get

82+ put = S.put

83+ state = S.state

8284

8385instance MonadState tag s m => MonadState tag s (StateT tag' s' m) where

84− get proxy = lift (get proxy)

85− put proxy = lift . put proxy

86− state proxy = lift . state proxy

86+ get t = lift (get t)

87+ put t = lift . put t

88+ state t = lift . state t

8789

8890-- Instances for other tagged transformers

8991

9092instance (MonadState tag s m) => MonadState tag s (ReaderT tag' r m) where

91− get proxy = lift (get proxy)

92− put proxy = lift . put proxy

93− state proxy = lift . state proxy

93+ get t = lift (get t)

94+ put t = lift . put t

95+ state t = lift . state t

9496

9597instance (MonadState tag s m) => MonadState tag s (ExceptT tag' e m) where

96− get proxy = lift (get proxy)

97− put proxy = lift . put proxy

98− state proxy = lift . state proxy

98+ get t = lift (get t)

99+ put t = lift . put t

100+ state t = lift . state t

99101

100102-- Instances for mtl transformers

101103

102104instance MonadState tag s m => MonadState tag s (Trans.ContT r m) where

103− get proxy = lift (get proxy)

104− put proxy = lift . put proxy

105− state proxy = lift . state proxy

105+ get t = lift (get t)

106+ put t = lift . put t

107+ state t = lift . state t

106108

107109instance MonadState tag s m => MonadState tag s (Trans.ExceptT e m) where

108− get proxy = lift (get proxy)

109− put proxy = lift . put proxy

110− state proxy = lift . state proxy

110+ get t = lift (get t)

111+ put t = lift . put t

112+ state t = lift . state t

111113

112114instance MonadState tag s m => MonadState tag s (Trans.IdentityT m) where

113− get proxy = lift (get proxy)

114− put proxy = lift . put proxy

115− state proxy = lift . state proxy

115+ get t = lift (get t)

116+ put t = lift . put t

117+ state t = lift . state t

116118

117119instance MonadState tag s m => MonadState tag s (Trans.ListT m) where

118− get proxy = lift (get proxy)

119− put proxy = lift . put proxy

120− state proxy = lift . state proxy

120+ get t = lift (get t)

121+ put t = lift . put t

122+ state t = lift . state t

121123

122124instance MonadState tag s m => MonadState tag s (Trans.MaybeT m) where

123− get proxy = lift (get proxy)

124− put proxy = lift . put proxy

125− state proxy = lift . state proxy

125+ get t = lift (get t)

126+ put t = lift . put t

127+ state t = lift . state t

126128

127129instance MonadState tag s m => MonadState tag s (Trans.ReaderT r m) where

128− get proxy = lift (get proxy)

129− put proxy = lift . put proxy

130− state proxy = lift . state proxy

130+ get t = lift (get t)

131+ put t = lift . put t

132+ state t = lift . state t

131133

132134instance MonadState tag s m => MonadState tag s (Trans.Lazy.StateT s' m) where

133− get proxy = lift (get proxy)

134− put proxy = lift . put proxy

135− state proxy = lift . state proxy

135+ get t = lift (get t)

136+ put t = lift . put t

137+ state t = lift . state t

136138

137139instance MonadState tag s m => MonadState tag s (Trans.Strict.StateT s' m) where

138− get proxy = lift (get proxy)

139− put proxy = lift . put proxy

140− state proxy = lift . state proxy

140+ get t = lift (get t)

141+ put t = lift . put t

142+ state t = lift . state t

141143

142144instance (Monoid w, MonadState tag s m) => MonadState tag s (Trans.Lazy.WriterT w m) where

143− get proxy = lift (get proxy)

144− put proxy = lift . put proxy

145− state proxy = lift . state proxy

145+ get t = lift (get t)

146+ put t = lift . put t

147+ state t = lift . state t

146148

147149instance (Monoid w, MonadState tag s m) => MonadState tag s (Trans.Strict.WriterT w m) where

148− get proxy = lift (get proxy)

149− put proxy = lift . put proxy

150− state proxy = lift . state proxy

150+ get t = lift (get t)

151+ put t = lift . put t

152+ state t = lift . state t

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

@@ -10,17 +10,24 @@ module Control.Monad.Trans.Ether.Except

1010 (

1111 -- * The Except monad

1212 Except

13+ , except

1314 , runExcept

1415 -- * The ExceptT monad transformer

1516 , ExceptT

1617 , exceptT

1718 , runExceptT

1819 , mapExceptT

20+ -- * Exception operations

21+ , throw

22+ , catch

1923 -- * Lifting other operations

2024 , liftCallCC

2125 , liftListen

2226 , liftPass

2327 , liftCatch

28+ -- * Wrapping operations

29+ , tagWrap

30+ , tagUnwrap

2431 ) where

2532

2633import Data.Proxy (Proxy(Proxy))

@@ -32,6 +39,7 @@ import Control.Monad.Fix (MonadFix)

3239import Control.Monad.Trans.Class (MonadTrans, lift)

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

3441import Control.Ether.Tags (Tags)

42+import qualified Control.Ether.Util as Util

3543

3644import qualified Control.Monad.Signatures as Sig

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

@@ -53,7 +61,7 @@ type Except tag e = ExceptT tag e Identity

5361

5462-- | Runs an 'Except' and returns either an exception or a normal value.

5563runExcept :: proxy tag -> Except tag e a -> Either e a

56−runExcept proxy m = runIdentity (runExceptT proxy m)

64+runExcept t = Trans.runExcept . tagUnwrap t

5765

5866-- | The exception monad transformer.

5967--

@@ -64,17 +72,28 @@ newtype ExceptT tag e m a = ExceptT (Trans.ExceptT e m a)

6472 deriving ( Functor, Applicative, Alternative, Monad, MonadPlus

6573 , MonadFix, MonadTrans, MonadIO )

6674

75+tagWrap :: proxy tag -> Trans.ExceptT e m a -> ExceptT tag e m a

76+tagWrap _ = ExceptT

77+

78+tagUnwrap :: proxy tag -> ExceptT tag e m a -> Trans.ExceptT e m a

79+tagUnwrap _ (ExceptT a) = a

80+

6781type instance Tags (ExceptT tag r m) = tag ': Tags m

6882

6983-- | Constructor for computations in the exception monad transformer.

7084exceptT :: proxy tag -> m (Either e a) -> ExceptT tag e m a

71−exceptT _proxy = ExceptT . Trans.ExceptT

85+exceptT t = tagWrap t . Trans.ExceptT

86+

87+-- | Constructor for computations in the exception monad

88+-- (the inverse of 'runExcept').

89+except :: proxy tag -> Either e a -> Except tag e a

90+except t = tagWrap t . Trans.except

7291

7392-- | Runs an 'ExceptT' and returns either an exception or a normal value.

7493runExceptT :: proxy tag -> ExceptT tag e m a -> m (Either e a)

75−runExceptT _proxy (ExceptT (Trans.ExceptT f)) = f

94+runExceptT t = Trans.runExceptT . tagUnwrap t

7695

77−-- | Transform the computation inside an 'ExceptT'.

96+-- | Transforms the computation inside an 'ExceptT'.

7897--

7998-- * @'runExceptT' tag ('mapExceptT' tag f m) = f ('runExceptT' tag m)@

8099mapExceptT

@@ -82,23 +101,29 @@ mapExceptT

82101 -> (m (Either e a) -> n (Either e' b))

83102 -> ExceptT tag e m a

84103 -> ExceptT tag e' n b

85−mapExceptT _proxy f m = ExceptT $ Trans.mapExceptT f (coerce m)

104+mapExceptT t f m = tagWrap t $ Trans.mapExceptT f (coerce m)

105+

106+throw :: Monad m => proxy tag -> e -> ExceptT tag e m a

107+throw t = tagWrap t . Trans.throwE

108+

109+catch :: Monad m => proxy tag -> ExceptT tag e m a -> (e -> ExceptT tag e m a) -> ExceptT tag e m a

110+catch t m h = tagWrap t $ Trans.catchE (coerce m) (coerce . h)

86111

87112-- | Lift a @callCC@ operation to the new monad.

88113liftCallCC :: proxy tag -> Sig.CallCC m (Either e a) (Either e b) -> Sig.CallCC (ExceptT tag e m) a b

89−liftCallCC _proxy callCC f = ExceptT $ Trans.liftCallCC callCC (coerce f)

114+liftCallCC t callCC f = tagWrap t $ Trans.liftCallCC callCC (coerce f)

90115

91116-- | Lift a @listen@ operation to the new monad.

92117liftListen :: Monad m => proxy tag -> Sig.Listen w m (Either e a) -> Sig.Listen w (ExceptT tag e m) a

93−liftListen _proxy listen m = ExceptT $ Trans.liftListen listen (coerce m)

118+liftListen t listen m = tagWrap t $ Trans.liftListen listen (coerce m)

94119

95120-- | Lift a @pass@ operation to the new monad.

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

97−liftPass _proxy pass m = ExceptT $ Trans.liftPass pass (coerce m)

122+liftPass t pass m = tagWrap t $ Trans.liftPass pass (coerce m)

98123

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

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

101−liftCatch proxy catchE m h = exceptT proxy $ catchE (runExceptT proxy m) (runExceptT proxy . h)

126+liftCatch t catchE m h = tagWrap t $ Util.liftCatch_ExceptT catchE (coerce m) (coerce h)

102127

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

104129 callCC = liftCallCC Proxy Class.callCC

src/Control/Monad/Trans/Ether/Reader.hs+55−6

@@ -10,15 +10,23 @@ module Control.Monad.Trans.Ether.Reader

1010 (

1111 -- * The Reader monad

1212 Reader

13+ , reader

1314 , runReader

1415 -- * The ReaderT monad transformer

1516 , ReaderT

1617 , readerT

1718 , runReaderT

1819 , mapReaderT

20+ , withReaderT

21+ -- * Reader operations

22+ , ask

23+ , local

1924 -- * Lifting other operations

2025 , liftCatch

2126 , liftCallCC

27+ -- * Wrapping operations

28+ , tagWrap

29+ , tagUnwrap

2230 ) where

2331

2432import Data.Proxy (Proxy(Proxy))

@@ -57,35 +65,76 @@ newtype ReaderT tag r m a = ReaderT (Trans.ReaderT r m a)

5765 deriving ( Functor, Applicative, Alternative, Monad, MonadPlus

5866 , MonadFix, MonadTrans, MonadIO )

5967

68+tagWrap :: proxy tag -> Trans.ReaderT r m a -> ReaderT tag r m a

69+tagWrap _ = ReaderT

70+

71+tagUnwrap :: proxy tag -> ReaderT tag r m a -> Trans.ReaderT r m a

72+tagUnwrap _ (ReaderT a) = a

73+

6074type instance Tags (ReaderT tag r m) = tag ': Tags m

6175

6276-- | Constructor for computations in the reader monad transformer.

6377readerT :: proxy tag -> (r -> m a) -> ReaderT tag r m a

64−readerT _proxy = ReaderT . Trans.ReaderT

78+readerT t = tagWrap t . Trans.ReaderT

79+

80+-- | Constructor for computations in the reader monad

81+-- (the inverse of 'runReader').

82+reader :: Monad m => proxy tag -> (r -> a) -> ReaderT tag r m a

83+reader t = tagWrap t . Trans.reader

6584

6685-- | Runs a 'ReaderT' with the given environment

6786-- and returns the vinal value.

6887runReaderT :: proxy tag -> ReaderT tag r m a -> r -> m a

69−runReaderT _proxy (ReaderT (Trans.ReaderT f)) = f

88+runReaderT t = Trans.runReaderT . tagUnwrap t

7089

7190-- | Runs a 'ReaderT' with the given environment

7291-- and returns the vinal value.

7392runReader :: proxy tag -> Reader tag r a -> r -> a

74−runReader proxy m r = runIdentity (runReaderT proxy m r)

93+runReader t = Trans.runReader . tagUnwrap t

7594

7695-- | Transform the computation inside a 'ReaderT'.

7796--

7897-- * @'runReaderT' tag ('mapReaderT' tag f m) = f . 'runReaderT' tag m@

7998mapReaderT :: proxy tag -> (m a -> n b) -> ReaderT tag r m a -> ReaderT tag r n b

80−mapReaderT _proxy f m = ReaderT $ Trans.mapReaderT f (coerce m)

99+mapReaderT t f m = tagWrap t $ Trans.mapReaderT f (coerce m)

100+

101+-- | Execute a computation in a modified environment

102+-- (a more general version of 'local').

103+--

104+-- * @'runReaderT' tag ('withReaderT' tag f m) = 'runReaderT' tag m . f@

105+withReaderT

106+ :: proxy tag

107+ -> (r' -> r)

108+ -- ^ The function to modify the environment.

109+ -> ReaderT tag r m a

110+ -- ^ Computation to run in the modified environment.

111+ -> ReaderT tag r' m a

112+withReaderT t f m = tagWrap t $ Trans.withReaderT f (coerce m)

81113

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

83115liftCatch :: proxy tag -> Sig.Catch e m a -> Sig.Catch e (ReaderT tag r m) a

84−liftCatch _proxy f m h = ReaderT $ Trans.liftCatch f (coerce m) (coerce h)

116+liftCatch t f m h = tagWrap t $ Trans.liftCatch f (coerce m) (coerce h)

85117

86118-- | Lift a @callCC@ operation to the new monad.

87119liftCallCC :: proxy tag -> Sig.CallCC m a b -> Sig.CallCC (ReaderT tag r m) a b

88−liftCallCC _proxy callCC f = ReaderT $ Trans.liftCallCC callCC (coerce f)

120+liftCallCC t callCC f = tagWrap t $ Trans.liftCallCC callCC (coerce f)

121+

122+-- | Fetch the value of the environment.

123+ask :: Monad m => proxy tag -> ReaderT tag r m r

124+ask t = tagWrap t Trans.ask

125+

126+-- | Execute a computation in a modified environment

127+-- (a specialization of 'withReaderT').

128+--

129+-- * @'runReaderT' tag ('local' tag f m) = 'runReaderT' tag m . f@

130+local

131+ :: proxy tag

132+ -> (r -> r)

133+ -- ^ The function to modify the environment.

134+ -> ReaderT tag r m a

135+ -- ^ Computation to run in the modified environment.

136+ -> ReaderT tag r m a

137+local = withReaderT

89138

90139-- Instances for mtl classes

91140

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

@@ -10,6 +10,7 @@ module Control.Monad.Trans.Ether.State

1010 (

1111 -- * The State monad

1212 State

13+ , state

1314 , runState

1415 , evalState

1516 , execState

@@ -20,11 +21,17 @@ module Control.Monad.Trans.Ether.State

2021 , evalStateT

2122 , execStateT

2223 , mapStateT

24+ -- * State operations

25+ , get

26+ , put

2327 -- * Litfing other operations

2428 , liftCatch

2529 , liftCallCC'

2630 , liftListen

2731 , liftPass

32+ -- * Wrapping operations

33+ , tagWrap

34+ , tagUnwrap

2835 ) where

2936

3037import Data.Proxy (Proxy(Proxy))

@@ -67,63 +74,82 @@ newtype StateT tag s m a = StateT (Trans.StateT s m a)

6774

6875type instance Tags (StateT tag r m) = tag ': Tags m

6976

77+tagWrap :: proxy tag -> Trans.StateT s m a -> StateT tag s m a

78+tagWrap _ = StateT

79+

80+tagUnwrap :: proxy tag -> StateT tag s m a -> Trans.StateT s m a

81+tagUnwrap _ (StateT a) = a

82+

7083-- | Constructor for computations in the state monad transformer.

7184stateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a

72−stateT _proxy = StateT . Trans.StateT

85+stateT t = tagWrap t . Trans.StateT

86+

87+-- | Constructor for computations in the state monad

88+-- (the inverse of 'runState').

89+state :: Monad m => proxy tag -> (s -> (a, s)) -> StateT tag s m a

90+state t = tagWrap t . Trans.state

7391

7492-- | Runs a 'StateT' with the given initial state

7593-- and returns both the final value and the final state.

7694runStateT :: proxy tag -> StateT tag s m a -> s -> m (a, s)

77−runStateT _proxy (StateT (Trans.StateT f)) = f

95+runStateT t = Trans.runStateT . tagUnwrap t

7896

7997-- | Runs a 'StateT' with the given initial state

8098-- and returns the final value, discarding the final state.

81−evalStateT :: Functor m => proxy tag -> StateT tag s m a -> s -> m a

82−evalStateT proxy m s = fmap fst (runStateT proxy m s)

99+evalStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m a

100+evalStateT t = Trans.evalStateT . tagUnwrap t

83101

84102-- | Runs a 'StateT' with the given initial state

85103-- and returns the final state, discarding the final value.

86−execStateT :: Functor m => proxy tag -> StateT tag s m a -> s -> m s

87−execStateT proxy m s = fmap snd (runStateT proxy m s)

104+execStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m s

105+execStateT t = Trans.execStateT . tagUnwrap t

88106

89107-- | Runs a 'State' with the given initial state

90108-- and returns both the final value and the final state.

91−runState :: proxy tag -> State tag s a -> s -> (a, s)

92−runState proxy m s = runIdentity (runStateT proxy m s)

109+runState :: proxy tag -> State tag s a -> s -> (a, s)

110+runState t = Trans.runState . tagUnwrap t

93111

94112-- | Runs a 'State' with the given initial state

95113-- and returns the final value, discarding the final state.

96−evalState :: proxy tag -> State tag s a -> s -> a

97−evalState proxy m s = runIdentity (evalStateT proxy m s)

114+evalState :: proxy tag -> State tag s a -> s -> a

115+evalState t = Trans.evalState . tagUnwrap t

98116

99117-- | Runs a 'State' with the given initial state

100118-- and returns the final state, discarding the final value.

101−execState :: proxy tag -> State tag s a -> s -> s

102−execState proxy m s = runIdentity (execStateT proxy m s)

119+execState :: proxy tag -> State tag s a -> s -> s

120+execState t = Trans.execState . tagUnwrap t

103121

104122-- | Transform the computation inside a 'StateT'.

105123--

106124-- * @'runStateT' tag ('mapStateT' tag f m) = f . 'runStateT' tag m@

107125mapStateT :: proxy tag -> (m (a, s) -> n (b, s)) -> StateT tag s m a -> StateT tag s n b

108−mapStateT _proxy f m = StateT $ Trans.mapStateT f (coerce m)

126+mapStateT t f m = tagWrap t $ Trans.mapStateT f (coerce m)

127+

128+-- | Fetch the current value of the state within the monad.

129+get :: Monad m => proxy tag -> StateT tag s m s

130+get t = tagWrap t Trans.get

131+

132+-- | Set the value of the state within the monad.

133+put :: Monad m => proxy tag -> s -> StateT tag s m ()

134+put t = tagWrap t . Trans.put

109135

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

111137liftCatch :: proxy tag -> Sig.Catch e m (a, s) -> Sig.Catch e (StateT tag s m) a

112−liftCatch _proxy f m h = StateT $ Trans.liftCatch f (coerce m) (coerce h)

138+liftCatch t f m h = tagWrap t $ Trans.liftCatch f (coerce m) (coerce h)

113139

114140-- | Lift a @listen@ operation to the new monad.

115141liftListen :: Monad m => proxy tag -> Sig.Listen w m (a, s) -> Sig.Listen w (StateT tag s m) a

116−liftListen _proxy listen m = StateT $ Trans.liftListen listen (coerce m)

142+liftListen t listen m = tagWrap t $ Trans.liftListen listen (coerce m)

117143

118144-- | In-situ lifting of a @callCC@ operation to the new monad.

119145-- This version uses the current state on entering the continuation.

120146-- It does not satisfy the uniformity property (see "Control.Monad.Signatures").

121147liftCallCC' :: proxy tag -> Sig.CallCC m (a, s) (b, s) -> Sig.CallCC (StateT tag s m) a b

122−liftCallCC' _proxy callCC f = StateT $ Trans.liftCallCC' callCC (coerce f)

148+liftCallCC' t callCC f = tagWrap t $ Trans.liftCallCC' callCC (coerce f)

123149

124150-- | Lift a @pass@ operation to the new monad.

125151liftPass :: Monad m => proxy tag -> Sig.Pass w m (a,s) -> Sig.Pass w (StateT tag s m) a

126−liftPass _proxy pass m = StateT $ Trans.liftPass pass (coerce m)

152+liftPass t pass m = tagWrap t $ Trans.liftPass pass (coerce m)

127153

128154-- Instances for mtl classes

129155