b297d44 · typeable/ether

ether.cabal+2

compare with master

unifiedsplit

@@ -30,6 +30,8 @@ library

30 Control.Monad.Trans.Ether.State

31 Control.Monad.Ether.Reader

32 Control.Monad.Ether.State

33+ Control.Monad.Ether.Implicit.Reader

34+ Control.Monad.Ether.Implicit.State

33

35

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

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

35 , transformers >=0.4.0.3

37 , transformers >=0.4.0.3

src/Control/Ether/TH.hs−8

@@ -4,8 +4,6 @@ module Control.Ether.TH (ethereal) where

4import qualified Language.Haskell.TH as TH

5

6import Data.Proxy

7−import Data.Functor.Identity

8−import Control.Monad.Ether.Reader

9

7

10emptyDataDecl :: TH.Name -> TH.DecQ

8emptyDataDecl :: TH.Name -> TH.DecQ

11emptyDataDecl name = TH.dataD (return []) name [] [] []

9emptyDataDecl name = TH.dataD (return []) name [] [] []

@@ -13,12 +11,6 @@ emptyDataDecl name = TH.dataD (return []) name [] [] []

13funSimple :: TH.Name -> TH.ExpQ -> TH.DecQ

11funSimple :: TH.Name -> TH.ExpQ -> TH.DecQ

14funSimple name body = TH.funD name [ TH.clause [] (TH.normalB body) [] ]

12funSimple name body = TH.funD name [ TH.clause [] (TH.normalB body) [] ]

15

13

16−tyVar :: String -> TH.Q (TH.TyVarBndr, TH.TypeQ)

17−tyVar name = do

18− thName <- TH.newName name

19− let thType = TH.varT thName

20− return (TH.PlainTV thName, thType)

21−

22proxySimple :: TH.Name -> TH.TypeQ -> TH.Q (TH.Dec, TH.Dec)

14proxySimple :: TH.Name -> TH.TypeQ -> TH.Q (TH.Dec, TH.Dec)

23proxySimple name ty = do

15proxySimple name ty = do

24 sig <- TH.sigD name [t| Proxy $ty |]

16 sig <- TH.sigD name [t| Proxy $ty |]

src/Control/Monad/Ether/Implicit/Reader.hsnew file+40

@@ -0,0 +1,40 @@

1+{-# LANGUAGE ConstraintKinds #-}

2+{-# LANGUAGE ScopedTypeVariables #-}

3+module Control.Monad.Ether.Implicit.Reader

4+ ( ReaderT

5+ , Reader

6+ , MonadReader

7+ , runReaderT

8+ , runReader

9+ , local

10+ , ask

11+ , reader

12+ , asks

13+ ) where

14+

15+import Data.Proxy

16+import qualified Control.Monad.Ether.Reader as Explicit

17+

18+type ReaderT r = Explicit.ReaderT r r

19+type Reader r = Explicit.Reader r r

20+

21+runReaderT :: ReaderT r m a -> r -> m a

22+runReaderT = Explicit.runReaderT Proxy

23+

24+runReader :: Reader r a -> r -> a

25+runReader = Explicit.runReader Proxy

26+

27+type MonadReader r = Explicit.MonadReader r r

28+

29+local :: forall m r a . MonadReader r m => (r -> r) -> m a -> m a

30+local = Explicit.local (Proxy :: Proxy r)

31+

32+ask :: forall m r . MonadReader r m => m r

33+ask = Explicit.ask (Proxy :: Proxy r)

34+

35+reader :: forall m r a . MonadReader r m => (r -> a) -> m a

36+reader = Explicit.reader (Proxy :: Proxy r)

37+

38+asks :: forall m r a . MonadReader r m => (r -> a) -> m a

39+asks = Explicit.asks (Proxy :: Proxy r)

40+

src/Control/Monad/Ether/Implicit/State.hsnew file+61

@@ -0,0 +1,61 @@

1+{-# LANGUAGE ConstraintKinds #-}

2+{-# LANGUAGE ScopedTypeVariables #-}

3+module Control.Monad.Ether.Implicit.State

4+ ( StateT

5+ , State

6+ , runStateT

7+ , runState

8+ , evalStateT

9+ , evalState

10+ , execStateT

11+ , execState

12+ --

13+ , MonadState

14+ , get

15+ , gets

16+ , put

17+ , state

18+ , modify

19+ ) where

20+

21+import Data.Proxy

22+import qualified Control.Monad.Ether.State as Explicit

23+

24+type StateT s = Explicit.StateT s s

25+type State s = Explicit.State s s

26+

27+runStateT :: StateT s m a -> s -> m (a, s)

28+runStateT = Explicit.runStateT Proxy

29+

30+runState :: State s a -> s -> (a, s)

31+runState = Explicit.runState Proxy

32+

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

34+evalStateT = Explicit.evalStateT Proxy

35+

36+evalState :: State s a -> s -> a

37+evalState = Explicit.evalState Proxy

38+

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

40+execStateT = Explicit.execStateT Proxy

41+

42+execState :: State s a -> s -> s

43+execState = Explicit.execState Proxy

44+

45+type MonadState s = Explicit.MonadState s s

46+

47+get :: forall m s . MonadState s m => m s

48+get = Explicit.get (Proxy :: Proxy s)

49+

50+gets :: forall m s a . MonadState s m => (s -> a) -> m a

51+gets = Explicit.gets (Proxy :: Proxy s)

52+

53+put :: forall m s . MonadState s m => s -> m ()

54+put = Explicit.put (Proxy :: Proxy s)

55+

56+state :: forall m s a . MonadState s m => (s -> (a, s)) -> m a

57+state = Explicit.state (Proxy :: Proxy s)

58+

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

60+modify = Explicit.modify (Proxy :: Proxy s)

61+

src/Control/Monad/Ether/Reader.hs+25−22

@@ -13,22 +13,14 @@

13module Control.Monad.Ether.Reader

14 ( ReaderT

15 , Reader

16− , ReaderT'

17− , Reader'

18 , runReaderT

16 , runReaderT

19 , runReader

17 , runReader

20− , runReaderT'

21− , runReader'

22 --

18 --

23 , MonadReader

19 , MonadReader

24 , local

20 , local

25 , ask

21 , ask

26 , reader

22 , reader

27− --

23+ , asks

28− , MonadReader'

29− , local'

30− , ask'

31− , reader'

32 ) where

24 ) where

33

25

34import Data.Proxy (Proxy(Proxy))

26import Data.Proxy (Proxy(Proxy))

@@ -53,24 +45,35 @@ class Monad m => MonadReader tag r m | m tag -> r where

53

45

54 {-# MINIMAL (ask | reader), local #-}

46 {-# MINIMAL (ask | reader), local #-}

55

47

56− local :: proxy tag -> (r -> r) -> m a -> m a

48+ -- | Retrieves the monad environment.

57−

58 ask :: proxy tag -> m r

49 ask :: proxy tag -> m r

59 ask proxy = reader proxy id

50 ask proxy = reader proxy id

60

51

52+ -- | Executes a computation in a modified environment.

53+ local

54+ :: proxy tag

55+ -> (r -> r)

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

57+ -> m a

58+ -- ^ @Reader@ to run in the modified environment.

59+ -> m a

60+

61+ -- | Retrieves a function of the current environment.

62+ reader

61− reader :: proxy tag -> (r -> a) -> m a

63+ :: proxy tag

64+ -> (r -> a)

65+ -- ^ The selector function to apply to the environment.

66+ -> m a

62 reader proxy f = fmap f (ask proxy)

67 reader proxy f = fmap f (ask proxy)

63

68

64−type MonadReader' r = MonadReader r r

69+-- | Retrieves a function of the current environment.

65−

70+asks

66−local' :: forall m r a . MonadReader' r m => (r -> r) -> m a -> m a

71+ :: MonadReader tag r m

67−local' = local (Proxy :: Proxy r)

72+ => proxy tag

68−

73+ -> (r -> a)

69−ask' :: forall m r . MonadReader' r m => m r

74+ -- ^ The selector function to apply to the environment.

70−ask' = ask (Proxy :: Proxy r)

75+ -> m a

71−

76+asks = reader

72−reader' :: forall m r a . MonadReader' r m => (r -> a) -> m a

73−reader' = reader (Proxy :: Proxy r)

74

77

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

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

76 ask proxy = etherReaderT proxy return

79 ask proxy = etherReaderT proxy return

src/Control/Monad/Ether/State.hs−33

@@ -13,20 +13,12 @@

13module Control.Monad.Ether.State

14 ( StateT

15 , State

16− , StateT'

17− , State'

18 , runStateT

16 , runStateT

19 , runState

17 , runState

20 , evalStateT

18 , evalStateT

21 , evalState

19 , evalState

22 , execStateT

20 , execStateT

23 , execState

21 , execState

24− , runStateT'

25− , runState'

26− , evalStateT'

27− , evalState'

28− , execStateT'

29− , execState'

30 --

22 --

31 , MonadState

23 , MonadState

32 , get

24 , get

@@ -34,16 +26,8 @@ module Control.Monad.Ether.State

34 , put

26 , put

35 , state

27 , state

36 , modify

28 , modify

37− --

38− , MonadState'

39− , get'

40− , gets'

41− , put'

42− , state'

43− , modify'

44 ) where

29 ) where

45

30

46−import Data.Proxy (Proxy(Proxy))

47import Control.Monad.Trans (lift)

31import Control.Monad.Trans (lift)

48

32

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

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

@@ -84,23 +68,6 @@ gets proxy f = fmap f (get proxy)

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

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

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

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

86

70

87−type MonadState' s = MonadState s s

88−

89−get' :: forall m s . MonadState' s m => m s

90−get' = get (Proxy :: Proxy s)

91−

92−gets' :: forall m s a . MonadState' s m => (s -> a) -> m a

93−gets' = gets (Proxy :: Proxy s)

94−

95−put' :: forall m s . MonadState' s m => s -> m ()

96−put' = put (Proxy :: Proxy s)

97−

98−state' :: forall m s a . MonadState' s m => (s -> (a, s)) -> m a

99−state' = state (Proxy :: Proxy s)

100−

101−modify' :: forall m s . MonadState' s m => (s -> s) -> m ()

102−modify' = modify (Proxy :: Proxy s)

103−

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

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

105 get proxy = etherStateT proxy (\s -> return (s, s))

72 get proxy = etherStateT proxy (\s -> return (s, s))

106 put proxy s = etherStateT proxy (\_ -> return ((), s))

73 put proxy s = etherStateT proxy (\_ -> return ((), s))

src/Control/Monad/Trans/Ether/Reader.hs−14

@@ -9,13 +9,8 @@

9module Control.Monad.Trans.Ether.Reader

10 ( ReaderT

11 , Reader

12− , ReaderT'

13− , Reader'

14 , runReaderT

12 , runReaderT

15 , runReader

13 , runReader

16− , runReaderT'

17− , runReader'

18− --

19 , etherReaderT

14 , etherReaderT

20 , mapReaderT

15 , mapReaderT

21 , liftCatch

16 , liftCatch

@@ -67,15 +62,6 @@ liftCatch _proxy f m h = ReaderT $ Trans.liftCatch f (coerce m) (coerce h)

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

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

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

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

69

64

70−type ReaderT' r = ReaderT r r

71−type Reader' r = Reader r r

72−

73−runReaderT' :: ReaderT' r m a -> r -> m a

74−runReaderT' = runReaderT Proxy

75−

76−runReader' :: Reader' r a -> r -> a

77−runReader' m r = runIdentity (runReaderT' m r)

78−

79-- Instances for mtl classes

65-- Instances for mtl classes

80

66

81instance Class.MonadCont m => Class.MonadCont (ReaderT tag r m) where

67instance Class.MonadCont m => Class.MonadCont (ReaderT tag r m) where

src/Control/Monad/Trans/Ether/State.hs−30

@@ -9,21 +9,12 @@

9module Control.Monad.Trans.Ether.State

10 ( StateT

11 , State

12− , StateT'

13− , State'

14 , runStateT

12 , runStateT

15 , runState

13 , runState

16 , evalStateT

14 , evalStateT

17 , evalState

15 , evalState

18 , execStateT

16 , execStateT

19 , execState

17 , execState

20− , runStateT'

21− , runState'

22− , evalStateT'

23− , evalState'

24− , execStateT'

25− , execState'

26− --

27 , etherStateT

18 , etherStateT

28 , mapStateT

19 , mapStateT

29 , liftCatch

20 , liftCatch

@@ -95,27 +86,6 @@ liftListen _proxy listen m = StateT $ Trans.liftListen listen (coerce m)

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

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

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

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

97

88

98−type StateT' s = StateT s s

99−type State' s = State s s

100−

101−runStateT' :: StateT' s m a -> s -> m (a, s)

102−runStateT' = runStateT Proxy

103−

104−runState' :: State' s a -> s -> (a, s)

105−runState' m s = runIdentity (runStateT' m s)

106−

107−evalStateT' :: Functor m => StateT' s m a -> s -> m a

108−evalStateT' m s = fmap fst (runStateT' m s)

109−

110−evalState' :: State' s a -> s -> a

111−evalState' m s = fst (runState' m s)

112−

113−execStateT' :: Functor m => StateT' s m a -> s -> m s

114−execStateT' m s = fmap snd (runStateT' m s)

115−

116−execState' :: State' s a -> s -> s

117−execState' m s = snd (runState' m s)

118−

119-- Instances for mtl classes

89-- Instances for mtl classes

120

90

121instance Class.MonadCont m => Class.MonadCont (StateT tag s m) where

91instance Class.MonadCont m => Class.MonadCont (StateT tag s m) where

test/Regression.hs+5−4

@@ -11,6 +11,7 @@ import Control.Ether.TH

11import Control.Ether.Wrapped

12import Control.Monad.Ether.Reader

13import Control.Monad.Ether.State

14+import qualified Control.Monad.Ether.Implicit.Reader as I

14import qualified Control.Monad.Reader as Tagless

15import qualified Control.Monad.Reader as Tagless

15

16

16import Test.Tasty

17import Test.Tasty

@@ -65,10 +66,10 @@ layeredLocalCore' k f a1 a2 = (direct, indirect)

65 direct = apply k (fromIntegral a1, apply f a2)

66 direct = apply k (fromIntegral a1, apply f a2)

66 indirect = layeredLocalCore (apply f) (\n m -> apply k (fromIntegral n, m))

67 indirect = layeredLocalCore (apply f) (\n m -> apply k (fromIntegral n, m))

67

68

68−inferCore :: (MonadReader' Int m, MonadReader' Bool m) => m String

69+implicitCore :: (I.MonadReader Int m, I.MonadReader Bool m) => m String

69−inferCore = local' (succ :: Int -> Int) $ do

70+implicitCore = I.local (succ :: Int -> Int) $ do

70− n :: Int <- ask'

71+ n :: Int <- I.ask

71− b <- local' not ask'

72+ b <- I.local not I.ask

72 return (if b then "" else show n)

73 return (if b then "" else show n)

73

74

74wrapCore :: MonadReader R1 Int m => m Int

75wrapCore :: MonadReader R1 Int m => m Int