git.iko.soy/typeable/ether
on master help sign in
Shorten names (remove Ether prefix)
aab0300Index Int
src/Control/Ether/Core.hs+33−33
compare with master
unifiedsplit
@@ -5,10 +5,10 @@
5{-# LANGUAGE TypeOperators #-}
5{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE UndecidableInstances #-}
6{-# LANGUAGE UndecidableInstances #-}
7module Control.Ether.Core
7module Control.Ether.Core
8− ( EtherTags
8+ ( Tags
9− , UniqueEtherTag
9+ , UniqueTag
10− , UniqueEtherTags
10+ , UniqueTags
11− , ensureUniqueEtherTags
11+ , ensureUniqueTags
12 ) where
12 ) where
13
13
14import Data.Proxy (Proxy)
14import Data.Proxy (Proxy)
@@ -31,10 +31,10 @@ import qualified Control.Monad.Trans.Writer.Lazy as Trans.Lazy
31import qualified Control.Monad.Trans.Writer.Strict as Trans.Strict
31import qualified Control.Monad.Trans.Writer.Strict as Trans.Strict
32
32
33-- Never declare instances for this class
33-- Never declare instances for this class
34−class UniqueEtherTag a
34+class UniqueTag a
35
35
36type family IsUnique (x :: k) (as :: [k]) :: Constraint where
36type family IsUnique (x :: k) (as :: [k]) :: Constraint where
37− IsUnique x (x ': as) = UniqueEtherTag x
37+ IsUnique x (x ': as) = UniqueTag x
38 IsUnique x (a ': as) = IsUnique x as
38 IsUnique x (a ': as) = IsUnique x as
39 IsUnique x '[] = ()
39 IsUnique x '[] = ()
40
40
@@ -42,34 +42,34 @@ type family Unique (as :: [k]) :: Constraint where
42 Unique '[] = ()
42 Unique '[] = ()
43 Unique (a ': as) = (IsUnique a as, Unique as)
43 Unique (a ': as) = (IsUnique a as, Unique as)
44
44
45−type family UniqueEtherTags (m :: * -> *) :: Constraint where
45+type family UniqueTags (m :: * -> *) :: Constraint where
46− UniqueEtherTags m = Unique (EtherTags m)
46+ UniqueTags m = Unique (Tags m)
47
47
48−ensureUniqueEtherTags :: UniqueEtherTags m => m a -> m a
48+ensureUniqueTags :: UniqueTags m => m a -> m a
49−ensureUniqueEtherTags = id
49+ensureUniqueTags = id
50
50
51−type family EtherTags (m :: * -> *) :: [*]
51+type family Tags (m :: * -> *) :: [*]
52
52
53−type instance EtherTags IO = '[]
53+type instance Tags IO = '[]
54−type instance EtherTags Identity = '[]
54+type instance Tags Identity = '[]
55−type instance EtherTags [] = '[]
55+type instance Tags [] = '[]
56−type instance EtherTags Maybe = '[]
56+type instance Tags Maybe = '[]
57−type instance EtherTags Last = '[]
57+type instance Tags Last = '[]
58−type instance EtherTags First = '[]
58+type instance Tags First = '[]
59−type instance EtherTags ((->) r) = '[]
59+type instance Tags ((->) r) = '[]
60−type instance EtherTags STM = '[]
60+type instance Tags STM = '[]
61−type instance EtherTags (Either e) = '[]
61+type instance Tags (Either e) = '[]
62−type instance EtherTags Proxy = '[]
62+type instance Tags Proxy = '[]
63−type instance EtherTags (Strict.ST s) = '[]
63+type instance Tags (Strict.ST s) = '[]
64−type instance EtherTags (Lazy.ST s) = '[]
64+type instance Tags (Lazy.ST s) = '[]
65
65
66−type instance EtherTags (Trans.ContT r m) = EtherTags m
66+type instance Tags (Trans.ContT r m) = Tags m
67−type instance EtherTags (Trans.ExceptT e m) = EtherTags m
67+type instance Tags (Trans.ExceptT e m) = Tags m
68−type instance EtherTags (Trans.IdentityT m) = EtherTags m
68+type instance Tags (Trans.IdentityT m) = Tags m
69−type instance EtherTags (Trans.ListT m) = EtherTags m
69+type instance Tags (Trans.ListT m) = Tags m
70−type instance EtherTags (Trans.MaybeT m) = EtherTags m
70+type instance Tags (Trans.MaybeT m) = Tags m
71−type instance EtherTags (Trans.ReaderT r m) = EtherTags m
71+type instance Tags (Trans.ReaderT r m) = Tags m
72−type instance EtherTags (Trans.Lazy.StateT s m) = EtherTags m
72+type instance Tags (Trans.Lazy.StateT s m) = Tags m
73−type instance EtherTags (Trans.Strict.StateT s m) = EtherTags m
73+type instance Tags (Trans.Strict.StateT s m) = Tags m
74−type instance EtherTags (Trans.Lazy.WriterT w m) = EtherTags m
74+type instance Tags (Trans.Lazy.WriterT w m) = Tags m
75−type instance EtherTags (Trans.Strict.WriterT w m) = EtherTags m
75+type instance Tags (Trans.Strict.WriterT w m) = Tags m
src/Control/Ether/TH.hs+5−71
@@ -1,9 +1,5 @@
1{-# LANGUAGE TemplateHaskell #-}
1{-# LANGUAGE TemplateHaskell #-}
2−module Control.Ether.TH
2+module Control.Ether.TH (ethereal) where
3− ( ethereal
4− , EtherealConfig (..)
5− , defaultEtherealReaderConfig
6− ) where
7
3
8import qualified Language.Haskell.TH as TH
4import qualified Language.Haskell.TH as TH
9
5
@@ -29,73 +25,11 @@ proxySimple name ty = do
29 val <- funSimple name [e| Proxy |]
25 val <- funSimple name [e| Proxy |]
30 return (sig, val)
26 return (sig, val)
31
27
32−data EtherealConfig
28+ethereal :: String -> String -> TH.DecsQ
33− = EtherealReaderConfig String String String String String String String
34−
35−defaultEtherealReaderConfig :: String -> EtherealConfig
36−defaultEtherealReaderConfig name = EtherealReaderConfig
37− ("Monad" ++ name)
38− ("Tag" ++ name)
39− ("tag" ++ name)
40− ("run" ++ name ++ "T")
41− ("run" ++ name)
42− ("ask" ++ name)
43− ("local" ++ name)
44−
45−ethereal :: EtherealConfig -> TH.DecsQ
46−
47−ethereal (EtherealReaderConfig
48− strEffName strTagName strTagProxyName
29+ethereal strTagName strTagProxyName = do
49− strRunTransName strRunName strAskName
50− strLocalName) = do
51− let effName = TH.mkName strEffName
52− tagName = TH.mkName strTagName
30+ let tagName = TH.mkName strTagName
53 tag = TH.conT tagName
31 tag = TH.conT tagName
54 tagProxyName = TH.mkName strTagProxyName
32 tagProxyName = TH.mkName strTagProxyName
55− runTransName = TH.mkName strRunTransName
56− runName = TH.mkName strRunName
57− askName = TH.mkName strAskName
58− localName = TH.mkName strLocalName
59− effDecl <- TH.tySynD effName [] [t| MonadEtherReader $tag |]
60 tagDecl <- emptyDataDecl tagName
33 tagDecl <- emptyDataDecl tagName
61 (tagProxySig, tagProxyVal) <- proxySimple tagProxyName tag
34 (tagProxySig, tagProxyVal) <- proxySimple tagProxyName tag
62− runTransFunSig <- do
63− (mBndr, m) <- tyVar "m"
64− (aBndr, a) <- tyVar "a"
65− (rBndr, r) <- tyVar "r"
66− TH.sigD runTransName
67− $ TH.forallT [mBndr, aBndr, rBndr] (return [])
68− [t| EtherReaderT $tag $r $m $a -> $r -> $m $a |]
69− runTransFunBody <- funSimple runTransName
70− [e| runEtherReaderT (Proxy :: Proxy $tag) |]
71− runFunSig <- do
72− (aBndr, a) <- tyVar "a"
73− (rBndr, r) <- tyVar "r"
74− TH.sigD runName
75− $ TH.forallT [aBndr, rBndr] (return [])
76− [t| EtherReaderT $tag $r Identity $a -> $r -> $a |]
77− runFunBody <- funSimple runName
78− [e| ((runIdentity.).) $(TH.varE runTransName) |]
79− askFunSig <- do
80− (mBndr, m) <- tyVar "m"
81− (rBndr, r) <- tyVar "r"
82− TH.sigD askName
83− $ TH.forallT [mBndr, rBndr]
84− (sequence [ [t| MonadEtherReader $tag $r $m |] ])
85− [t| $m $r |]
86− askFunBody <- funSimple askName [e| etherAsk (Proxy :: Proxy $tag) |]
87− localFunSig <- do
88− (mBndr, m) <- tyVar "m"
89− (aBndr, a) <- tyVar "a"
90− (rBndr, r) <- tyVar "r"
91− TH.sigD localName
92− $ TH.forallT [mBndr, aBndr, rBndr]
93− (sequence [ [t| MonadEtherReader $tag $r $m |] ])
94− [t| ($r -> $r) -> $m $a -> $m $a |]
95− localFunBody <- funSimple localName [e| etherLocal (Proxy :: Proxy $tag) |]
96− return [ effDecl, tagDecl
97− , tagProxySig, tagProxyVal
35+ return [tagDecl, tagProxySig, tagProxyVal]
98− , runTransFunSig, runTransFunBody
99− , runFunSig, runFunBody
100− , askFunSig, askFunBody
101− , localFunSig, localFunBody ]
src/Control/Ether/Wrapped.hs+3−3
@@ -19,9 +19,9 @@ newtype WrappedEther tag m a = WrapEther { unwrapEther :: m a }
19 deriving ( Functor, Applicative, Alternative, Monad, MonadPlus
19 deriving ( Functor, Applicative, Alternative, Monad, MonadPlus
20 , MonadFix, MonadIO )
20 , MonadFix, MonadIO )
21
21
22−instance MonadEtherReader tag r m => Class.MonadReader r (WrappedEther tag m) where
22+instance MonadReader tag r m => Class.MonadReader r (WrappedEther tag m) where
23− ask = WrapEther $ etherAsk (Proxy :: Proxy tag)
23+ ask = WrapEther $ ask (Proxy :: Proxy tag)
24− local f = WrapEther . etherLocal (Proxy :: Proxy tag) f . unwrapEther
24+ local f = WrapEther . local (Proxy :: Proxy tag) f . unwrapEther
25
25
26ethered :: proxy tag -> WrappedEther tag m a -> m a
26ethered :: proxy tag -> WrappedEther tag m a -> m a
27ethered _proxy = unwrapEther
27ethered _proxy = unwrapEther
src/Control/Monad/Ether/Reader.hs+59−59
@@ -11,19 +11,19 @@
11{-# LANGUAGE RankNTypes #-}
11{-# LANGUAGE RankNTypes #-}
12{-# LANGUAGE GeneralizedNewtypeDeriving #-}
12{-# LANGUAGE GeneralizedNewtypeDeriving #-}
13module Control.Monad.Ether.Reader
13module Control.Monad.Ether.Reader
14− ( EtherReaderT
14+ ( ReaderT
15− , EtherReader
15+ , Reader
16 , ReaderT'
16 , ReaderT'
17 , Reader'
17 , Reader'
18− , runEtherReaderT
18+ , runReaderT
19− , runEtherReader
19+ , runReader
20 , runReaderT'
20 , runReaderT'
21 , runReader'
21 , runReader'
22 --
22 --
23− , MonadEtherReader
23+ , MonadReader
24− , etherLocal
24+ , local
25− , etherAsk
25+ , ask
26− , etherReader
26+ , reader
27 --
27 --
28 , MonadReader'
28 , MonadReader'
29 , local'
29 , local'
@@ -34,7 +34,7 @@ module Control.Monad.Ether.Reader
34import Data.Proxy (Proxy(Proxy))
34import Data.Proxy (Proxy(Proxy))
35import Control.Monad.Trans (lift)
35import Control.Monad.Trans (lift)
36
36
37−import Control.Monad.Trans.Ether.State (EtherStateT, mapEtherStateT)
37+import Control.Monad.Trans.Ether.State (StateT, mapStateT)
38import Control.Monad.Trans.Ether.Reader
38import Control.Monad.Trans.Ether.Reader
39
39
40-- for mtl instances
40-- for mtl instances
@@ -49,81 +49,81 @@ import qualified Control.Monad.Trans.State.Strict as Trans.Strict (StateT , m
49import qualified Control.Monad.Trans.Writer.Lazy as Trans.Lazy (WriterT , mapWriterT)
49import qualified Control.Monad.Trans.Writer.Lazy as Trans.Lazy (WriterT , mapWriterT)
50import qualified Control.Monad.Trans.Writer.Strict as Trans.Strict (WriterT , mapWriterT)
50import qualified Control.Monad.Trans.Writer.Strict as Trans.Strict (WriterT , mapWriterT)
51
51
52−class Monad m => MonadEtherReader tag r m | m tag -> r where
52+class Monad m => MonadReader tag r m | m tag -> r where
53
53
54− {-# MINIMAL (etherAsk | etherReader), etherLocal #-}
54+ {-# MINIMAL (ask | reader), local #-}
55
55
56− etherLocal :: proxy tag -> (r -> r) -> m a -> m a
56+ local :: proxy tag -> (r -> r) -> m a -> m a
57
57
58− etherAsk :: proxy tag -> m r
58+ ask :: proxy tag -> m r
59− etherAsk proxy = etherReader proxy id
59+ ask proxy = reader proxy id
60
60
61− etherReader :: proxy tag -> (r -> a) -> m a
61+ reader :: proxy tag -> (r -> a) -> m a
62− etherReader proxy f = fmap f (etherAsk proxy)
62+ reader proxy f = fmap f (ask proxy)
63
63
64−type MonadReader' r = MonadEtherReader r r
64+type MonadReader' r = MonadReader r r
65
65
66local' :: forall m r a . MonadReader' r m => (r -> r) -> m a -> m a
66local' :: forall m r a . MonadReader' r m => (r -> r) -> m a -> m a
67−local' = etherLocal (Proxy :: Proxy r)
67+local' = local (Proxy :: Proxy r)
68
68
69ask' :: forall m r . MonadReader' r m => m r
69ask' :: forall m r . MonadReader' r m => m r
70−ask' = etherAsk (Proxy :: Proxy r)
70+ask' = ask (Proxy :: Proxy r)
71
71
72reader' :: forall m r a . MonadReader' r m => (r -> a) -> m a
72reader' :: forall m r a . MonadReader' r m => (r -> a) -> m a
73−reader' = etherReader (Proxy :: Proxy r)
73+reader' = reader (Proxy :: Proxy r)
74
74
75−instance {-# OVERLAPPING #-} Monad m => MonadEtherReader tag r (EtherReaderT tag r m) where
75+instance {-# OVERLAPPING #-} Monad m => MonadReader tag r (ReaderT tag r m) where
76− etherAsk proxy = etherReaderT proxy return
76+ ask proxy = etherReaderT proxy return
77− etherLocal proxy f m = etherReaderT proxy (runEtherReaderT proxy m . f)
77+ local proxy f m = etherReaderT proxy (runReaderT proxy m . f)
78
78
79−instance (MonadEtherReader tag r m) => MonadEtherReader tag r (EtherReaderT tag' r' m) where
79+instance (MonadReader tag r m) => MonadReader tag r (ReaderT tag' r' m) where
80− etherAsk proxy = lift (etherAsk proxy)
80+ ask proxy = lift (ask proxy)
81− etherLocal proxy = mapEtherReaderT Proxy . etherLocal proxy
81+ local proxy = mapReaderT Proxy . local proxy
82
82
83-- Instances for other tagged transformers
83-- Instances for other tagged transformers
84
84
85−instance (MonadEtherReader tag r m) => MonadEtherReader tag r (EtherStateT tag' s m) where
85+instance (MonadReader tag r m) => MonadReader tag r (StateT tag' s m) where
86− etherAsk proxy = lift (etherAsk proxy)
86+ ask proxy = lift (ask proxy)
87− etherLocal proxy = mapEtherStateT Proxy . etherLocal proxy
87+ local proxy = mapStateT Proxy . local proxy
88
88
89-- Instances for mtl transformers
89-- Instances for mtl transformers
90
90
91−instance MonadEtherReader tag r m => MonadEtherReader tag r (Trans.ContT r' m) where
91+instance MonadReader tag r m => MonadReader tag r (Trans.ContT r' m) where
92− etherAsk proxy = lift (etherAsk proxy)
92+ ask proxy = lift (ask proxy)
93− etherLocal proxy = Trans.liftLocal (etherAsk proxy) (etherLocal proxy)
93+ local proxy = Trans.liftLocal (ask proxy) (local proxy)
94
94
95−instance MonadEtherReader tag r m => MonadEtherReader tag r (Trans.ExceptT e m) where
95+instance MonadReader tag r m => MonadReader tag r (Trans.ExceptT e m) where
96− etherAsk proxy = lift (etherAsk proxy)
96+ ask proxy = lift (ask proxy)
97− etherLocal proxy = Trans.mapExceptT . etherLocal proxy
97+ local proxy = Trans.mapExceptT . local proxy
98
98
99−instance MonadEtherReader tag r m => MonadEtherReader tag r (Trans.IdentityT m) where
99+instance MonadReader tag r m => MonadReader tag r (Trans.IdentityT m) where
100− etherAsk proxy = lift (etherAsk proxy)
100+ ask proxy = lift (ask proxy)
101− etherLocal proxy = Trans.mapIdentityT . etherLocal proxy
101+ local proxy = Trans.mapIdentityT . local proxy
102
102
103−instance MonadEtherReader tag r m => MonadEtherReader tag r (Trans.ListT m) where
103+instance MonadReader tag r m => MonadReader tag r (Trans.ListT m) where
104− etherAsk proxy = lift (etherAsk proxy)
104+ ask proxy = lift (ask proxy)
105− etherLocal proxy = Trans.mapListT . etherLocal proxy
105+ local proxy = Trans.mapListT . local proxy
106
106
107−instance MonadEtherReader tag r m => MonadEtherReader tag r (Trans.MaybeT m) where
107+instance MonadReader tag r m => MonadReader tag r (Trans.MaybeT m) where
108− etherAsk proxy = lift (etherAsk proxy)
108+ ask proxy = lift (ask proxy)
109− etherLocal proxy = Trans.mapMaybeT . etherLocal proxy
109+ local proxy = Trans.mapMaybeT . local proxy
110
110
111−instance MonadEtherReader tag r m => MonadEtherReader tag r (Trans.ReaderT r' m) where
111+instance MonadReader tag r m => MonadReader tag r (Trans.ReaderT r' m) where
112− etherAsk proxy = lift (etherAsk proxy)
112+ ask proxy = lift (ask proxy)
113− etherLocal proxy = Trans.mapReaderT . etherLocal proxy
113+ local proxy = Trans.mapReaderT . local proxy
114
114
115−instance MonadEtherReader tag r m => MonadEtherReader tag r (Trans.Lazy.StateT s m) where
115+instance MonadReader tag r m => MonadReader tag r (Trans.Lazy.StateT s m) where
116− etherAsk proxy = lift (etherAsk proxy)
116+ ask proxy = lift (ask proxy)
117− etherLocal proxy = Trans.Lazy.mapStateT . etherLocal proxy
117+ local proxy = Trans.Lazy.mapStateT . local proxy
118
118
119−instance MonadEtherReader tag r m => MonadEtherReader tag r (Trans.Strict.StateT s m) where
119+instance MonadReader tag r m => MonadReader tag r (Trans.Strict.StateT s m) where
120− etherAsk proxy = lift (etherAsk proxy)
120+ ask proxy = lift (ask proxy)
121− etherLocal proxy = Trans.Strict.mapStateT . etherLocal proxy
121+ local proxy = Trans.Strict.mapStateT . local proxy
122
122
123−instance (Monoid w, MonadEtherReader tag r m) => MonadEtherReader tag r (Trans.Lazy.WriterT w m) where
123+instance (Monoid w, MonadReader tag r m) => MonadReader tag r (Trans.Lazy.WriterT w m) where
124− etherAsk proxy = lift (etherAsk proxy)
124+ ask proxy = lift (ask proxy)
125− etherLocal proxy = Trans.Lazy.mapWriterT . etherLocal proxy
125+ local proxy = Trans.Lazy.mapWriterT . local proxy
126
126
127−instance (Monoid w, MonadEtherReader tag r m) => MonadEtherReader tag r (Trans.Strict.WriterT w m) where
127+instance (Monoid w, MonadReader tag r m) => MonadReader tag r (Trans.Strict.WriterT w m) where
128− etherAsk proxy = lift (etherAsk proxy)
128+ ask proxy = lift (ask proxy)
129− etherLocal proxy = Trans.Strict.mapWriterT . etherLocal proxy
129+ local proxy = Trans.Strict.mapWriterT . local proxy
src/Control/Monad/Ether/State.hs+95−95
@@ -11,16 +11,16 @@
11{-# LANGUAGE RankNTypes #-}
11{-# LANGUAGE RankNTypes #-}
12{-# LANGUAGE GeneralizedNewtypeDeriving #-}
12{-# LANGUAGE GeneralizedNewtypeDeriving #-}
13module Control.Monad.Ether.State
13module Control.Monad.Ether.State
14− ( EtherStateT
14+ ( StateT
15− , EtherState
15+ , State
16 , StateT'
16 , StateT'
17 , State'
17 , State'
18− , runEtherStateT
18+ , runStateT
19− , runEtherState
19+ , runState
20− , evalEtherStateT
20+ , evalStateT
21− , evalEtherState
21+ , evalState
22− , execEtherStateT
22+ , execStateT
23− , execEtherState
23+ , execState
24 , runStateT'
24 , runStateT'
25 , runState'
25 , runState'
26 , evalStateT'
26 , evalStateT'
@@ -28,12 +28,12 @@ module Control.Monad.Ether.State
28 , execStateT'
28 , execStateT'
29 , execState'
29 , execState'
30 --
30 --
31− , MonadEtherState
31+ , MonadState
32− , etherGet
32+ , get
33− , etherGets
33+ , gets
34− , etherPut
34+ , put
35− , etherState
35+ , state
36− , etherModify
36+ , modify
37 --
37 --
38 , MonadState'
38 , MonadState'
39 , get'
39 , get'
@@ -46,7 +46,7 @@ module Control.Monad.Ether.State
46import Data.Proxy (Proxy(Proxy))
46import Data.Proxy (Proxy(Proxy))
47import Control.Monad.Trans (lift)
47import Control.Monad.Trans (lift)
48
48
49−import Control.Monad.Trans.Ether.Reader (EtherReaderT)
49+import Control.Monad.Trans.Ether.Reader (ReaderT)
50import Control.Monad.Trans.Ether.State
50import Control.Monad.Trans.Ether.State
51
51
52-- for mtl instances
52-- for mtl instances
@@ -61,110 +61,110 @@ import qualified Control.Monad.Trans.State.Strict as Trans.Strict (StateT)
61import qualified Control.Monad.Trans.Writer.Lazy as Trans.Lazy (WriterT)
61import qualified Control.Monad.Trans.Writer.Lazy as Trans.Lazy (WriterT)
62import qualified Control.Monad.Trans.Writer.Strict as Trans.Strict (WriterT)
62import qualified Control.Monad.Trans.Writer.Strict as Trans.Strict (WriterT)
63
63
64−class Monad m => MonadEtherState tag s m | m tag -> s where
64+class Monad m => MonadState tag s m | m tag -> s where
65
65
66− {-# MINIMAL etherState | etherGet, etherPut #-}
66+ {-# MINIMAL state | get, put #-}
67
67
68− etherGet :: proxy tag -> m s
68+ get :: proxy tag -> m s
69− etherGet proxy = etherState proxy (\s -> (s, s))
69+ get proxy = state proxy (\s -> (s, s))
70
70
71− etherPut :: proxy tag -> s -> m ()
71+ put :: proxy tag -> s -> m ()
72− etherPut proxy s = etherState proxy (\_ -> ((), s))
72+ put proxy s = state proxy (\_ -> ((), s))
73
73
74− etherState :: proxy tag -> (s -> (a, s)) -> m a
74+ state :: proxy tag -> (s -> (a, s)) -> m a
75− etherState proxy f = do
75+ state proxy f = do
76− s <- etherGet proxy
76+ s <- get proxy
77 let ~(a, s') = f s
77 let ~(a, s') = f s
78− etherPut proxy s'
78+ put proxy s'
79 return a
79 return a
80
80
81−etherGets :: MonadEtherState tag s m => proxy tag -> (s -> a) -> m a
81+gets :: MonadState tag s m => proxy tag -> (s -> a) -> m a
82−etherGets proxy f = fmap f (etherGet proxy)
82+gets proxy f = fmap f (get proxy)
83
83
84−etherModify :: MonadEtherState tag s m => proxy tag -> (s -> s) -> m ()
84+modify :: MonadState tag s m => proxy tag -> (s -> s) -> m ()
85−etherModify proxy f = etherState proxy $ \ s -> ((), f s)
85+modify proxy f = state proxy $ \ s -> ((), f s)
86
86
87−type MonadState' s = MonadEtherState s s
87+type MonadState' s = MonadState s s
88
88
89get' :: forall m s . MonadState' s m => m s
89get' :: forall m s . MonadState' s m => m s
90−get' = etherGet (Proxy :: Proxy s)
90+get' = get (Proxy :: Proxy s)
91
91
92gets' :: forall m s a . MonadState' s m => (s -> a) -> m a
92gets' :: forall m s a . MonadState' s m => (s -> a) -> m a
93−gets' = etherGets (Proxy :: Proxy s)
93+gets' = gets (Proxy :: Proxy s)
94
94
95put' :: forall m s . MonadState' s m => s -> m ()
95put' :: forall m s . MonadState' s m => s -> m ()
96−put' = etherPut (Proxy :: Proxy s)
96+put' = put (Proxy :: Proxy s)
97
97
98state' :: forall m s a . MonadState' s m => (s -> (a, s)) -> m a
98state' :: forall m s a . MonadState' s m => (s -> (a, s)) -> m a
99−state' = etherState (Proxy :: Proxy s)
99+state' = state (Proxy :: Proxy s)
100
100
101modify' :: forall m s . MonadState' s m => (s -> s) -> m ()
101modify' :: forall m s . MonadState' s m => (s -> s) -> m ()
102−modify' = etherModify (Proxy :: Proxy s)
102+modify' = modify (Proxy :: Proxy s)
103
103
104−instance {-# OVERLAPPING #-} Monad m => MonadEtherState tag s (EtherStateT tag s m) where
104+instance {-# OVERLAPPING #-} Monad m => MonadState tag s (StateT tag s m) where
105− etherGet proxy = etherStateT proxy (\s -> return (s, s))
105+ get proxy = etherStateT proxy (\s -> return (s, s))
106− etherPut proxy s = etherStateT proxy (\_ -> return ((), s))
106+ put proxy s = etherStateT proxy (\_ -> return ((), s))
107
107
108−instance (MonadEtherState tag s m) => MonadEtherState tag s (EtherStateT tag' s' m) where
108+instance (MonadState tag s m) => MonadState tag s (StateT tag' s' m) where
109− etherGet proxy = lift (etherGet proxy)
109+ get proxy = lift (get proxy)
110− etherPut proxy = lift . etherPut proxy
110+ put proxy = lift . put proxy
111− etherState proxy = lift . etherState proxy
111+ state proxy = lift . state proxy
112
112
113-- Instances for other tagged transformers
113-- Instances for other tagged transformers
114
114
115−instance (MonadEtherState tag s m) => MonadEtherState tag s (EtherReaderT tag' r m) where
115+instance (MonadState tag s m) => MonadState tag s (ReaderT tag' r m) where
116− etherGet proxy = lift (etherGet proxy)
116+ get proxy = lift (get proxy)
117− etherPut proxy = lift . etherPut proxy
117+ put proxy = lift . put proxy
118− etherState proxy = lift . etherState proxy
118+ state proxy = lift . state proxy
119
119
120-- Instances for mtl transformers
120-- Instances for mtl transformers
121
121
122−instance MonadEtherState tag s m => MonadEtherState tag s (Trans.ContT r m) where
122+instance MonadState tag s m => MonadState tag s (Trans.ContT r m) where
123− etherGet proxy = lift (etherGet proxy)
123+ get proxy = lift (get proxy)
124− etherPut proxy = lift . etherPut proxy
124+ put proxy = lift . put proxy
125− etherState proxy = lift . etherState proxy
125+ state proxy = lift . state proxy
126−
126+
127−instance MonadEtherState tag s m => MonadEtherState tag s (Trans.ExceptT e m) where
127+instance MonadState tag s m => MonadState tag s (Trans.ExceptT e m) where
128− etherGet proxy = lift (etherGet proxy)
128+ get proxy = lift (get proxy)
129− etherPut proxy = lift . etherPut proxy
129+ put proxy = lift . put proxy
130− etherState proxy = lift . etherState proxy
130+ state proxy = lift . state proxy
131−
131+
132−instance MonadEtherState tag s m => MonadEtherState tag s (Trans.IdentityT m) where
132+instance MonadState tag s m => MonadState tag s (Trans.IdentityT m) where
133− etherGet proxy = lift (etherGet proxy)
133+ get proxy = lift (get proxy)
134− etherPut proxy = lift . etherPut proxy
134+ put proxy = lift . put proxy
135− etherState proxy = lift . etherState proxy
135+ state proxy = lift . state proxy
136−
136+
137−instance MonadEtherState tag s m => MonadEtherState tag s (Trans.ListT m) where
137+instance MonadState tag s m => MonadState tag s (Trans.ListT m) where
138− etherGet proxy = lift (etherGet proxy)
138+ get proxy = lift (get proxy)
139− etherPut proxy = lift . etherPut proxy
139+ put proxy = lift . put proxy
140− etherState proxy = lift . etherState proxy
140+ state proxy = lift . state proxy
141−
141+
142−instance MonadEtherState tag s m => MonadEtherState tag s (Trans.MaybeT m) where
142+instance MonadState tag s m => MonadState tag s (Trans.MaybeT m) where
143− etherGet proxy = lift (etherGet proxy)
143+ get proxy = lift (get proxy)
144− etherPut proxy = lift . etherPut proxy
144+ put proxy = lift . put proxy
145− etherState proxy = lift . etherState proxy
145+ state proxy = lift . state proxy
146−
146+
147−instance MonadEtherState tag s m => MonadEtherState tag s (Trans.ReaderT r m) where
147+instance MonadState tag s m => MonadState tag s (Trans.ReaderT r m) where
148− etherGet proxy = lift (etherGet proxy)
148+ get proxy = lift (get proxy)
149− etherPut proxy = lift . etherPut proxy
149+ put proxy = lift . put proxy
150− etherState proxy = lift . etherState proxy
150+ state proxy = lift . state proxy
151−
151+
152−instance MonadEtherState tag s m => MonadEtherState tag s (Trans.Lazy.StateT s' m) where
152+instance MonadState tag s m => MonadState tag s (Trans.Lazy.StateT s' m) where
153− etherGet proxy = lift (etherGet proxy)
153+ get proxy = lift (get proxy)
154− etherPut proxy = lift . etherPut proxy
154+ put proxy = lift . put proxy
155− etherState proxy = lift . etherState proxy
155+ state proxy = lift . state proxy
156−
156+
157−instance MonadEtherState tag s m => MonadEtherState tag s (Trans.Strict.StateT s' m) where
157+instance MonadState tag s m => MonadState tag s (Trans.Strict.StateT s' m) where
158− etherGet proxy = lift (etherGet proxy)
158+ get proxy = lift (get proxy)
159− etherPut proxy = lift . etherPut proxy
159+ put proxy = lift . put proxy
160− etherState proxy = lift . etherState proxy
160+ state proxy = lift . state proxy
161−
161+
162−instance (Monoid w, MonadEtherState tag s m) => MonadEtherState tag s (Trans.Lazy.WriterT w m) where
162+instance (Monoid w, MonadState tag s m) => MonadState tag s (Trans.Lazy.WriterT w m) where
163− etherGet proxy = lift (etherGet proxy)
163+ get proxy = lift (get proxy)
164− etherPut proxy = lift . etherPut proxy
164+ put proxy = lift . put proxy
165− etherState proxy = lift . etherState proxy
165+ state proxy = lift . state proxy
166−
166+
167−instance (Monoid w, MonadEtherState tag s m) => MonadEtherState tag s (Trans.Strict.WriterT w m) where
167+instance (Monoid w, MonadState tag s m) => MonadState tag s (Trans.Strict.WriterT w m) where
168− etherGet proxy = lift (etherGet proxy)
168+ get proxy = lift (get proxy)
169− etherPut proxy = lift . etherPut proxy
169+ put proxy = lift . put proxy
170− etherState proxy = lift . etherState proxy
170+ state proxy = lift . state proxy
src/Control/Monad/Trans/Ether/Reader.hs+32−32
@@ -7,17 +7,17 @@
7{-# LANGUAGE TypeOperators #-}
7{-# LANGUAGE TypeOperators #-}
8{-# LANGUAGE GeneralizedNewtypeDeriving #-}
8{-# LANGUAGE GeneralizedNewtypeDeriving #-}
9module Control.Monad.Trans.Ether.Reader
9module Control.Monad.Trans.Ether.Reader
10− ( EtherReaderT
10+ ( ReaderT
11− , EtherReader
11+ , Reader
12 , ReaderT'
12 , ReaderT'
13 , Reader'
13 , Reader'
14− , runEtherReaderT
14+ , runReaderT
15− , runEtherReader
15+ , runReader
16 , runReaderT'
16 , runReaderT'
17 , runReader'
17 , runReader'
18 --
18 --
19 , etherReaderT
19 , etherReaderT
20− , mapEtherReaderT
20+ , mapReaderT
21 , liftCatch
21 , liftCatch
22 , liftCallCC
22 , liftCallCC
23 ) where
23 ) where
@@ -33,7 +33,7 @@ import Control.Monad.IO.Class (MonadIO)
33import Control.Ether.Core
33import Control.Ether.Core
34
34
35import qualified Control.Monad.Signatures as Sig
35import qualified Control.Monad.Signatures as Sig
36−import qualified Control.Monad.Trans.Reader as R
36+import qualified Control.Monad.Trans.Reader as Trans
37
37
38import qualified Control.Monad.Cont.Class as Class
38import qualified Control.Monad.Cont.Class as Class
39import qualified Control.Monad.Reader.Class as Class
39import qualified Control.Monad.Reader.Class as Class
@@ -41,62 +41,62 @@ import qualified Control.Monad.State.Class as Class
41import qualified Control.Monad.Writer.Class as Class
41import qualified Control.Monad.Writer.Class as Class
42import qualified Control.Monad.Error.Class as Class
42import qualified Control.Monad.Error.Class as Class
43
43
44−newtype EtherReaderT tag r m a = EtherReaderT (R.ReaderT r m a)
44+newtype ReaderT tag r m a = ReaderT (Trans.ReaderT r m a)
45 deriving ( Functor, Applicative, Alternative, Monad, MonadPlus
45 deriving ( Functor, Applicative, Alternative, Monad, MonadPlus
46 , MonadFix, MonadTrans, MonadIO )
46 , MonadFix, MonadTrans, MonadIO )
47
47
48−type instance EtherTags (EtherReaderT tag r m) = tag ': EtherTags m
48+type instance Tags (ReaderT tag r m) = tag ': Tags m
49
49
50−type EtherReader tag r = EtherReaderT tag r Identity
50+type Reader tag r = ReaderT tag r Identity
51
51
52−etherReaderT :: proxy tag -> (r -> m a) -> EtherReaderT tag r m a
52+etherReaderT :: proxy tag -> (r -> m a) -> ReaderT tag r m a
53−etherReaderT _proxy = EtherReaderT . R.ReaderT
53+etherReaderT _proxy = ReaderT . Trans.ReaderT
54
54
55−runEtherReaderT :: proxy tag -> EtherReaderT tag r m a -> r -> m a
55+runReaderT :: proxy tag -> ReaderT tag r m a -> r -> m a
56−runEtherReaderT _proxy (EtherReaderT (R.ReaderT f)) = f
56+runReaderT _proxy (ReaderT (Trans.ReaderT f)) = f
57
57
58−runEtherReader :: proxy tag -> EtherReader tag r a -> r -> a
58+runReader :: proxy tag -> Reader tag r a -> r -> a
59−runEtherReader proxy m r = runIdentity (runEtherReaderT proxy m r)
59+runReader proxy m r = runIdentity (runReaderT proxy m r)
60
60
61−mapEtherReaderT :: proxy tag -> (m a -> n b) -> EtherReaderT tag r m a -> EtherReaderT tag r n b
61+mapReaderT :: proxy tag -> (m a -> n b) -> ReaderT tag r m a -> ReaderT tag r n b
62−mapEtherReaderT _proxy f m = EtherReaderT $ R.mapReaderT f (coerce m)
62+mapReaderT _proxy f m = ReaderT $ Trans.mapReaderT f (coerce m)
63
63
64−liftCatch :: proxy tag -> Sig.Catch e m a -> Sig.Catch e (EtherReaderT tag r m) a
64+liftCatch :: proxy tag -> Sig.Catch e m a -> Sig.Catch e (ReaderT tag r m) a
65−liftCatch _proxy f m h = EtherReaderT $ R.liftCatch f (coerce m) (coerce h)
65+liftCatch _proxy f m h = ReaderT $ Trans.liftCatch f (coerce m) (coerce h)
66
66
67−liftCallCC :: proxy tag -> Sig.CallCC m a b -> Sig.CallCC (EtherReaderT tag r m) a b
67+liftCallCC :: proxy tag -> Sig.CallCC m a b -> Sig.CallCC (ReaderT tag r m) a b
68−liftCallCC _proxy callCC f = EtherReaderT $ R.liftCallCC callCC (coerce f)
68+liftCallCC _proxy callCC f = ReaderT $ Trans.liftCallCC callCC (coerce f)
69
69
70−type ReaderT' r = EtherReaderT r r
70+type ReaderT' r = ReaderT r r
71−type Reader' r = EtherReader r r
71+type Reader' r = Reader r r
72
72
73runReaderT' :: ReaderT' r m a -> r -> m a
73runReaderT' :: ReaderT' r m a -> r -> m a
74−runReaderT' = runEtherReaderT Proxy
74+runReaderT' = runReaderT Proxy
75
75
76runReader' :: Reader' r a -> r -> a
76runReader' :: Reader' r a -> r -> a
77runReader' m r = runIdentity (runReaderT' m r)
77runReader' m r = runIdentity (runReaderT' m r)
78
78
79-- Instances for mtl classes
79-- Instances for mtl classes
80
80
81−instance Class.MonadCont m => Class.MonadCont (EtherReaderT tag r m) where
81+instance Class.MonadCont m => Class.MonadCont (ReaderT tag r m) where
82 callCC = liftCallCC Proxy Class.callCC
82 callCC = liftCallCC Proxy Class.callCC
83
83
84−instance Class.MonadReader r' m => Class.MonadReader r' (EtherReaderT tag r m) where
84+instance Class.MonadReader r' m => Class.MonadReader r' (ReaderT tag r m) where
85 ask = lift Class.ask
85 ask = lift Class.ask
86− local = mapEtherReaderT Proxy . Class.local
86+ local = mapReaderT Proxy . Class.local
87 reader = lift . Class.reader
87 reader = lift . Class.reader
88
88
89−instance Class.MonadState s m => Class.MonadState s (EtherReaderT tag r m) where
89+instance Class.MonadState s m => Class.MonadState s (ReaderT tag r m) where
90 get = lift Class.get
90 get = lift Class.get
91 put = lift . Class.put
91 put = lift . Class.put
92 state = lift . Class.state
92 state = lift . Class.state
93
93
94−instance Class.MonadWriter w m => Class.MonadWriter w (EtherReaderT tag r m) where
94+instance Class.MonadWriter w m => Class.MonadWriter w (ReaderT tag r m) where
95 writer = lift . Class.writer
95 writer = lift . Class.writer
96 tell = lift . Class.tell
96 tell = lift . Class.tell
97− listen = mapEtherReaderT Proxy Class.listen
97+ listen = mapReaderT Proxy Class.listen
98− pass = mapEtherReaderT Proxy Class.pass
98+ pass = mapReaderT Proxy Class.pass
99
99
100−instance Class.MonadError e m => Class.MonadError e (EtherReaderT tag r m) where
100+instance Class.MonadError e m => Class.MonadError e (ReaderT tag r m) where
101 throwError = lift . Class.throwError
101 throwError = lift . Class.throwError
102 catchError = liftCatch Proxy Class.catchError
102 catchError = liftCatch Proxy Class.catchError
src/Control/Monad/Trans/Ether/State.hs+46−46
@@ -7,16 +7,16 @@
7{-# LANGUAGE TypeOperators #-}
7{-# LANGUAGE TypeOperators #-}
8{-# LANGUAGE GeneralizedNewtypeDeriving #-}
8{-# LANGUAGE GeneralizedNewtypeDeriving #-}
9module Control.Monad.Trans.Ether.State
9module Control.Monad.Trans.Ether.State
10− ( EtherStateT
10+ ( StateT
11− , EtherState
11+ , State
12 , StateT'
12 , StateT'
13 , State'
13 , State'
14− , runEtherStateT
14+ , runStateT
15− , runEtherState
15+ , runState
16− , evalEtherStateT
16+ , evalStateT
17− , evalEtherState
17+ , evalState
18− , execEtherStateT
18+ , execStateT
19− , execEtherState
19+ , execState
20 , runStateT'
20 , runStateT'
21 , runState'
21 , runState'
22 , evalStateT'
22 , evalStateT'
@@ -25,7 +25,7 @@ module Control.Monad.Trans.Ether.State
25 , execState'
25 , execState'
26 --
26 --
27 , etherStateT
27 , etherStateT
28− , mapEtherStateT
28+ , mapStateT
29 , liftCatch
29 , liftCatch
30 , liftCallCC'
30 , liftCallCC'
31 , liftListen
31 , liftListen
@@ -43,7 +43,7 @@ import Control.Monad.IO.Class (MonadIO)
43import Control.Ether.Core
43import Control.Ether.Core
44
44
45import qualified Control.Monad.Signatures as Sig
45import qualified Control.Monad.Signatures as Sig
46−import qualified Control.Monad.Trans.State.Lazy as S
46+import qualified Control.Monad.Trans.State.Lazy as Trans
47
47
48import qualified Control.Monad.Cont.Class as Class
48import qualified Control.Monad.Cont.Class as Class
49import qualified Control.Monad.Reader.Class as Class
49import qualified Control.Monad.Reader.Class as Class
@@ -51,55 +51,55 @@ import qualified Control.Monad.State.Class as Class
51import qualified Control.Monad.Writer.Class as Class
51import qualified Control.Monad.Writer.Class as Class
52import qualified Control.Monad.Error.Class as Class
52import qualified Control.Monad.Error.Class as Class
53
53
54−newtype EtherStateT tag s m a = EtherStateT (S.StateT s m a)
54+newtype StateT tag s m a = StateT (Trans.StateT s m a)
55 deriving ( Functor, Applicative, Alternative, Monad, MonadPlus
55 deriving ( Functor, Applicative, Alternative, Monad, MonadPlus
56 , MonadFix, MonadTrans, MonadIO )
56 , MonadFix, MonadTrans, MonadIO )
57
57
58−type instance EtherTags (EtherStateT tag r m) = tag ': EtherTags m
58+type instance Tags (StateT tag r m) = tag ': Tags m
59
59
60−type EtherState tag r = EtherStateT tag r Identity
60+type State tag r = StateT tag r Identity
61
61
62−etherStateT :: proxy tag -> (s -> m (a, s)) -> EtherStateT tag s m a
62+etherStateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a
63−etherStateT _proxy = EtherStateT . S.StateT
63+etherStateT _proxy = StateT . Trans.StateT
64
64
65−runEtherStateT :: proxy tag -> EtherStateT tag s m a -> s -> m (a, s)
65+runStateT :: proxy tag -> StateT tag s m a -> s -> m (a, s)
66−runEtherStateT _proxy (EtherStateT (S.StateT f)) = f
66+runStateT _proxy (StateT (Trans.StateT f)) = f
67
67
68−runEtherState :: proxy tag -> EtherState tag s a -> s -> (a, s)
68+runState :: proxy tag -> State tag s a -> s -> (a, s)
69−runEtherState proxy m s = runIdentity (runEtherStateT proxy m s)
69+runState proxy m s = runIdentity (runStateT proxy m s)
70
70
71−evalEtherStateT :: Functor m => proxy tag -> EtherStateT tag s m a -> s -> m a
71+evalStateT :: Functor m => proxy tag -> StateT tag s m a -> s -> m a
72−evalEtherStateT proxy m s = fmap fst (runEtherStateT proxy m s)
72+evalStateT proxy m s = fmap fst (runStateT proxy m s)
73
73
74−evalEtherState :: proxy tag -> EtherState tag s a -> s -> a
74+evalState :: proxy tag -> State tag s a -> s -> a
75−evalEtherState proxy m s = fst (runEtherState proxy m s)
75+evalState proxy m s = fst (runState proxy m s)
76
76
77−execEtherStateT :: Functor m => proxy tag -> EtherStateT tag s m a -> s -> m s
77+execStateT :: Functor m => proxy tag -> StateT tag s m a -> s -> m s
78−execEtherStateT proxy m s = fmap snd (runEtherStateT proxy m s)
78+execStateT proxy m s = fmap snd (runStateT proxy m s)
79
79
80−execEtherState :: proxy tag -> EtherState tag s a -> s -> s
80+execState :: proxy tag -> State tag s a -> s -> s
81−execEtherState proxy m s = snd (runEtherState proxy m s)
81+execState proxy m s = snd (runState proxy m s)
82
82
83−mapEtherStateT :: proxy tag -> (m (a, s) -> n (b, s)) -> EtherStateT tag s m a -> EtherStateT tag s n b
83+mapStateT :: proxy tag -> (m (a, s) -> n (b, s)) -> StateT tag s m a -> StateT tag s n b
84−mapEtherStateT _proxy f m = EtherStateT $ S.mapStateT f (coerce m)
84+mapStateT _proxy f m = StateT $ Trans.mapStateT f (coerce m)
85
85
86−liftCatch :: proxy tag -> Sig.Catch e m (a, s) -> Sig.Catch e (EtherStateT tag s m) a
86+liftCatch :: proxy tag -> Sig.Catch e m (a, s) -> Sig.Catch e (StateT tag s m) a
87−liftCatch _proxy f m h = EtherStateT $ S.liftCatch f (coerce m) (coerce h)
87+liftCatch _proxy f m h = StateT $ Trans.liftCatch f (coerce m) (coerce h)
88
88
89−liftCallCC' :: proxy tag -> Sig.CallCC m (a, s) (b, s) -> Sig.CallCC (EtherStateT tag s m) a b
89+liftCallCC' :: proxy tag -> Sig.CallCC m (a, s) (b, s) -> Sig.CallCC (StateT tag s m) a b
90−liftCallCC' _proxy callCC f = EtherStateT $ S.liftCallCC' callCC (coerce f)
90+liftCallCC' _proxy callCC f = StateT $ Trans.liftCallCC' callCC (coerce f)
91
91
92−liftListen :: Monad m => proxy tag -> Sig.Listen w m (a, s) -> Sig.Listen w (EtherStateT tag s m) a
92+liftListen :: Monad m => proxy tag -> Sig.Listen w m (a, s) -> Sig.Listen w (StateT tag s m) a
93−liftListen _proxy listen m = EtherStateT $ S.liftListen listen (coerce m)
93+liftListen _proxy listen m = StateT $ Trans.liftListen listen (coerce m)
94
94
95−liftPass :: Monad m => proxy tag -> Sig.Pass w m (a,s) -> Sig.Pass w (EtherStateT tag s m) a
95+liftPass :: Monad m => proxy tag -> Sig.Pass w m (a,s) -> Sig.Pass w (StateT tag s m) a
96−liftPass _proxy pass m = EtherStateT $ S.liftPass pass (coerce m)
96+liftPass _proxy pass m = StateT $ Trans.liftPass pass (coerce m)
97
97
98−type StateT' s = EtherStateT s s
98+type StateT' s = StateT s s
99−type State' s = EtherState s s
99+type State' s = State s s
100
100
101runStateT' :: StateT' s m a -> s -> m (a, s)
101runStateT' :: StateT' s m a -> s -> m (a, s)
102−runStateT' = runEtherStateT Proxy
102+runStateT' = runStateT Proxy
103
103
104runState' :: State' s a -> s -> (a, s)
104runState' :: State' s a -> s -> (a, s)
105runState' m s = runIdentity (runStateT' m s)
105runState' m s = runIdentity (runStateT' m s)
@@ -118,25 +118,25 @@ execState' m s = snd (runState' m s)
118
118
119-- Instances for mtl classes
119-- Instances for mtl classes
120
120
121−instance Class.MonadCont m => Class.MonadCont (EtherStateT tag s m) where
121+instance Class.MonadCont m => Class.MonadCont (StateT tag s m) where
122 callCC = liftCallCC' Proxy Class.callCC
122 callCC = liftCallCC' Proxy Class.callCC
123
123
124−instance Class.MonadReader r m => Class.MonadReader r (EtherStateT tag s m) where
124+instance Class.MonadReader r m => Class.MonadReader r (StateT tag s m) where
125 ask = lift Class.ask
125 ask = lift Class.ask
126− local = mapEtherStateT Proxy . Class.local
126+ local = mapStateT Proxy . Class.local
127 reader = lift . Class.reader
127 reader = lift . Class.reader
128
128
129−instance Class.MonadState s' m => Class.MonadState s' (EtherStateT tag s m) where
129+instance Class.MonadState s' m => Class.MonadState s' (StateT tag s m) where
130 get = lift Class.get
130 get = lift Class.get
131 put = lift . Class.put
131 put = lift . Class.put
132 state = lift . Class.state
132 state = lift . Class.state
133
133
134−instance Class.MonadWriter w m => Class.MonadWriter w (EtherStateT tag s m) where
134+instance Class.MonadWriter w m => Class.MonadWriter w (StateT tag s m) where
135 writer = lift . Class.writer
135 writer = lift . Class.writer
136 tell = lift . Class.tell
136 tell = lift . Class.tell
137 listen = liftListen Proxy Class.listen
137 listen = liftListen Proxy Class.listen
138 pass = liftPass Proxy Class.pass
138 pass = liftPass Proxy Class.pass
139
139
140−instance Class.MonadError e m => Class.MonadError e (EtherStateT tag s m) where
140+instance Class.MonadError e m => Class.MonadError e (StateT tag s m) where
141 throwError = lift . Class.throwError
141 throwError = lift . Class.throwError
142 catchError = liftCatch Proxy Class.catchError
142 catchError = liftCatch Proxy Class.catchError
test/Regression.hs+29−32
@@ -6,28 +6,27 @@
6{-# LANGUAGE ScopedTypeVariables #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7module Main where
7module Main where
8
8
9−import Data.Proxy
10−
11import Control.Ether.Core
9import Control.Ether.Core
12import Control.Ether.TH
10import Control.Ether.TH
13import Control.Ether.Wrapped
11import Control.Ether.Wrapped
14import Control.Monad.Ether.Reader
12import Control.Monad.Ether.Reader
15import Control.Monad.Ether.State
13import Control.Monad.Ether.State
16−import Control.Monad.Reader
14+import qualified Control.Monad.Reader as Tagless
17
15
18import Test.Tasty
16import Test.Tasty
19import Test.Tasty.QuickCheck
17import Test.Tasty.QuickCheck
20import Test.QuickCheck.Function
18import Test.QuickCheck.Function
21
19
22−ethereal (defaultEtherealReaderConfig "Reader1")
20+ethereal "R1" "r1"
23−ethereal (defaultEtherealReaderConfig "Reader2")
21+ethereal "R2" "r2"
22+ethereal "S1" "s1"
24
23
25main :: IO ()
24main :: IO ()
26main = defaultMain suite
25main = defaultMain suite
27
26
28suite :: TestTree
27suite :: TestTree
29suite = testGroup "Ether"
28suite = testGroup "Ether"
30− [ testGroup "EtherReaderT"
29+ [ testGroup "ReaderT"
31 [ testProperty "layered sum (local left)" layeredLocalLeft
30 [ testProperty "layered sum (local left)" layeredLocalLeft
32 , testProperty "layered sum (local right)" layeredLocalRight
31 , testProperty "layered sum (local right)" layeredLocalRight
33 ]
32 ]
@@ -40,24 +39,24 @@ layeredLocalLeft, layeredLocalRight
40
39
41layeredLocalLeft k f a1 a2 = property (direct == run indirect)
40layeredLocalLeft k f a1 a2 = property (direct == run indirect)
42 where
41 where
43− run = flip runReader1 a1 . flip runReader2T a2
42+ run = flip (runReader r1) a1 . flip (runReaderT r2) a2
44 (direct, indirect) = layeredLocalCore' k f a1 a2
43 (direct, indirect) = layeredLocalCore' k f a1 a2
45
44
46layeredLocalRight k f a1 a2 = property (direct == run indirect)
45layeredLocalRight k f a1 a2 = property (direct == run indirect)
47 where
46 where
48− run = flip runReader2 a2 . flip runReader1T a1
47+ run = flip (runReader r2) a2 . flip (runReaderT r1) a1
49 (direct, indirect) = layeredLocalCore' k f a1 a2
48 (direct, indirect) = layeredLocalCore' k f a1 a2
50
49
51layeredLocalCore
50layeredLocalCore
52− :: (MonadReader1 r1 m, MonadReader2 r2 m)
51+ :: (MonadReader R1 r1 m, MonadReader R2 r2 m)
53 => (r2 -> r2) -> (r1 -> r2 -> a) -> m a
52 => (r2 -> r2) -> (r1 -> r2 -> a) -> m a
54layeredLocalCore f g = do
53layeredLocalCore f g = do
55− n <- askReader1
54+ n <- ask r1
56− m <- localReader2 f askReader2
55+ m <- local r2 f (ask r2)
57 return (g n m)
56 return (g n m)
58
57
59layeredLocalCore'
58layeredLocalCore'
60− :: (MonadReader1 Int m, MonadReader2 Integer m)
59+ :: (MonadReader R1 Int m, MonadReader R2 Integer m)
61 => Fun (Int, Integer) Integer
60 => Fun (Int, Integer) Integer
62 -> Fun Integer Integer
61 -> Fun Integer Integer
63 -> Int -> Integer -> (Integer, m Integer)
62 -> Int -> Integer -> (Integer, m Integer)
@@ -72,32 +71,30 @@ inferCore = local' (succ :: Int -> Int) $ do
72 b <- local' not ask'
71 b <- local' not ask'
73 return (if b then "" else show n)
72 return (if b then "" else show n)
74
73
75−wrapCore :: MonadEtherReader TagReader1 Int m => m Int
74+wrapCore :: MonadReader R1 Int m => m Int
76−wrapCore = ethered tagReader1 ask
75+wrapCore = ethered r1 Tagless.ask
77
76
78
77
79−-- Should not compile with `ensureUniqueEtherTags`
78+-- Should not compile with `ensureUniqueTags`
80uniqueTagsCore :: IO ()
79uniqueTagsCore :: IO ()
81−uniqueTagsCore = flip runReader1T (1 :: Int)
80+uniqueTagsCore = flip (runReaderT r1) (1 :: Int)
82− . flip runReader1T (True :: Bool)
81+ . flip (runReaderT r1) (True :: Bool)
83− . flip runReader1T (2 :: Int)
82+ . flip (runReaderT r1) (2 :: Int)
84− . flip runReader1T (3 :: Integer)
83+ . flip (runReaderT r1) (3 :: Integer)
85− {- . ensureUniqueEtherTags -}
84+ {- . ensureUniqueTags -}
86 $ do
85 $ do
87− a :: Integer <- askReader1
86+ a :: Integer <- ask r1
88− b :: Int <- askReader1
87+ b :: Int <- ask r1
89− c :: Bool <- askReader1
88+ c :: Bool <- ask r1
90− liftIO $ do
89+ Tagless.liftIO $ do
91 print a
90 print a
92 print b
91 print b
93 print c
92 print c
94
93
95−data TagState1
96−
97−stateCore :: ( MonadEtherState TagState1 Int m
94+stateCore :: ( MonadState S1 Int m
98− , MonadEtherReader TagReader1 Int m
95+ , MonadReader R1 Int m
99− , UniqueEtherTags m ) => m ()
96+ , UniqueTags m ) => m ()
100stateCore = do
97stateCore = do
101− a <- etherAsk (Proxy :: Proxy TagReader1)
98+ a <- ask r1
102− n <- etherGet (Proxy :: Proxy TagState1)
99+ n <- get s1
103− etherPut (Proxy :: Proxy TagState1) (n * a)
100+ put s1 (n * a)