b297d44 · typeable/ether

git.iko.soy/typeable/ether

Separate modules for implicit tagging

commitb297d44ceed23bf3b75a31842a7e906dacc5ca41 authorIndex Int <vlad.z.4096@gmail.com> dateThu 11 Jun 2015, 08:38 (11 years ago) parentaab0300

9 files changed+133−111

compare with master

unifiedsplit

ether.cabal+2 src/Control/Ether/TH.hs−8 src/Control/Monad/Ether/Implicit/Reader.hs+40 src/Control/Monad/Ether/Implicit/State.hs+61 src/Control/Monad/Ether/Reader.hs+25−22 src/Control/Monad/Ether/State.hs−33 src/Control/Monad/Trans/Ether/Reader.hs−14 src/Control/Monad/Trans/Ether/State.hs−30 test/Regression.hs+5−4

ether.cabal+2

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

3030 Control.Monad.Trans.Ether.State

3131 Control.Monad.Ether.Reader

3232 Control.Monad.Ether.State

33+ Control.Monad.Ether.Implicit.Reader

34+ Control.Monad.Ether.Implicit.State

3335

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

3537 , transformers >=0.4.0.3

src/Control/Ether/TH.hs−8

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

44import qualified Language.Haskell.TH as TH

66import Data.Proxy

7−import Data.Functor.Identity

8−import Control.Monad.Ether.Reader

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

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

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

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

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

1513

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−

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

2315proxySimple name ty = do

2416 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 @@

1313module Control.Monad.Ether.Reader

1414 ( ReaderT

1515 , Reader

16− , ReaderT'

17− , Reader'

1816 , runReaderT

1917 , runReader

20− , runReaderT'

21− , runReader'

2218 --

2319 , MonadReader

2420 , local

2521 , ask

2622 , reader

27− --

28− , MonadReader'

29− , local'

30− , ask'

31− , reader'

23+ , asks

3224 ) where

3325

3426import Data.Proxy (Proxy(Proxy))

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

5345

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

5547

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

57−

48+ -- | Retrieves the monad environment.

5849 ask :: proxy tag -> m r

5950 ask proxy = reader proxy id

6051

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

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

63+ :: proxy tag

64+ -> (r -> a)

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

66+ -> m a

6267 reader proxy f = fmap f (ask proxy)

6368

64−type MonadReader' r = MonadReader r r

65−

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

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

68−

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

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

71−

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

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

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

70+asks

71+ :: MonadReader tag r m

72+ => proxy tag

73+ -> (r -> a)

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

75+ -> m a

76+asks = reader

7477

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

7679 ask proxy = etherReaderT proxy return

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

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

1313module Control.Monad.Ether.State

1414 ( StateT

1515 , State

16− , StateT'

17− , State'

1816 , runStateT

1917 , runState

2018 , evalStateT

2119 , evalState

2220 , execStateT

2321 , execState

24− , runStateT'

25− , runState'

26− , evalStateT'

27− , evalState'

28− , execStateT'

29− , execState'

3022 --

3123 , MonadState

3224 , get

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

3426 , put

3527 , state

3628 , modify

37− --

38− , MonadState'

39− , get'

40− , gets'

41− , put'

42− , state'

43− , modify'

4429 ) where

4530

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

4731import Control.Monad.Trans (lift)

4832

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

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

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

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

8670

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−

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

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

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

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

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

99module Control.Monad.Trans.Ether.Reader

1010 ( ReaderT

1111 , Reader

12− , ReaderT'

13− , Reader'

1412 , runReaderT

1513 , runReader

16− , runReaderT'

17− , runReader'

18− --

1914 , etherReaderT

2015 , mapReaderT

2116 , liftCatch

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

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

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

6964

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−

7965-- Instances for mtl classes

8066

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

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

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

99module Control.Monad.Trans.Ether.State

1010 ( StateT

1111 , State

12− , StateT'

13− , State'

1412 , runStateT

1513 , runState

1614 , evalStateT

1715 , evalState

1816 , execStateT

1917 , execState

20− , runStateT'

21− , runState'

22− , evalStateT'

23− , evalState'

24− , execStateT'

25− , execState'

26− --

2718 , etherStateT

2819 , mapStateT

2920 , liftCatch

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

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

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

9788

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−

11989-- Instances for mtl classes

12090

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

test/Regression.hs+5−4

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

1111import Control.Ether.Wrapped

1212import Control.Monad.Ether.Reader

1313import Control.Monad.Ether.State

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

1415import qualified Control.Monad.Reader as Tagless

1516

1617import Test.Tasty

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

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

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

6768

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

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

70− n :: Int <- ask'

71− b <- local' not ask'

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

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

71+ n :: Int <- I.ask

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

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

7374

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