c4c12dc · typeable/ether

git.iko.soy/typeable/ether

Merge pull request #18 from int-index/proxy-hash

Proxy# for tags

commitc4c12dc0146c44bc85eeaeaff94a91ba611de03a authorIndex Int <vlad.z.4096@gmail.com> dateSat 30 Apr 2016, 16:10 (10 years ago) parent3977c8b 7312823

26 files changed+229−228

compare with master

unifiedsplit

ether.cabal+4 src/Control/Ether/TH.hs+11−37 src/Control/Monad/Ether.hs+1−1 src/Control/Monad/Ether/Except.hs+4−2 src/Control/Monad/Ether/Except/Class.hs+4−3 src/Control/Monad/Ether/Implicit.hs−1 src/Control/Monad/Ether/Implicit/Except.hs+9−8 src/Control/Monad/Ether/Implicit/Reader.hs+9−8 src/Control/Monad/Ether/Implicit/State/Lazy.hs+14−13 src/Control/Monad/Ether/Implicit/State/Strict.hs+14−13 src/Control/Monad/Ether/Implicit/Writer.hs+13−12 src/Control/Monad/Ether/Reader/Class.hs+6−4 src/Control/Monad/Ether/State/Class.hs+7−5 src/Control/Monad/Ether/Writer/Class.hs+8−6 src/Control/Monad/Trans/Ether/Dispatch.hs+25−24 src/Control/Monad/Trans/Ether/Except.hs+8−6 src/Control/Monad/Trans/Ether/Reader.hs+8−6 src/Control/Monad/Trans/Ether/State/Lazy.hs+12−10 src/Control/Monad/Trans/Ether/State/Strict.hs+12−10 src/Control/Monad/Trans/Ether/Writer.hs+11−9 test/Regression/T1.hs+9−9 test/Regression/T3.hs+13−13 test/Regression/T4.hs+4−4 test/Regression/T7.hs+4−4 test/Regression/T8.hs+10−10 test/Regression/T9.hs+9−10

ether.cabal+4

@@ -67,6 +67,7 @@ library

6767 , transformers-base >=0.4.4

6868 , exceptions >=0.8

6969 , template-haskell >=2.9

70+ , ghc-prim >=0.3

7071

7172 default-language: Haskell2010

7273 other-extensions: CPP

@@ -77,6 +78,7 @@ library

7778 FlexibleInstances

7879 FunctionalDependencies

7980 GeneralizedNewtypeDeriving

81+ MagicHash

8082 MultiParamTypeClasses

8183 ScopedTypeVariables

8284 TemplateHaskell

@@ -96,6 +98,7 @@ test-suite regression

9698 , tasty >=0.10

9799 , tasty-quickcheck >=0.8

98100 , QuickCheck >=2.8

101+ , ghc-prim >=0.3

99102 , ether

100103

101104 main-is: Regression.hs

@@ -124,4 +127,5 @@ test-suite regression

124127 TemplateHaskell

125128 TypeFamilies

126129 TypeOperators

130+ QuasiQuotes

127131 ghc-options: -Wall -fno-warn-missing-signatures

src/Control/Ether/TH.hs+11−37

@@ -1,45 +1,19 @@

11{-# LANGUAGE TemplateHaskell #-}

2−{-# LANGUAGE CPP #-}

2+{-# LANGUAGE MagicHash #-}

44-- | Template Haskell utilities.

6−module Control.Ether.TH

7− ( ethereal

8− ) where

6+module Control.Ether.TH (tag) where

108import qualified Language.Haskell.TH as TH

9+import qualified Language.Haskell.TH.Quote as TH

1110

12−import Data.Proxy

11+import GHC.Prim (Proxy#, proxy#)

1312

14−emptyDataDecl :: TH.Name -> TH.DecQ

15−#if __GLASGOW_HASKELL__ < 800

16−emptyDataDecl name = TH.dataD (return []) name [] [] []

17−#else

18−emptyDataDecl name = TH.dataD (return []) name [] Nothing [] (return [])

19−#endif

20−

21−funSimple :: TH.Name -> TH.ExpQ -> TH.DecQ

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

23−

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

25−proxySimple name ty = do

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

27− val <- funSimple name [e| Proxy |]

28− return (sig, val)

29−

30−-- |

31−-- Creates a tag and a value-level proxy for it.

32−--

33−-- @'ethereal' \"Foo\" \"foo\"@ generates the following code:

34−--

35−-- > data Foo

36−-- > foo :: Proxy Foo

37−-- > foo = Proxy

38−ethereal :: String -> String -> TH.DecsQ

39−ethereal strTagName strTagProxyName = do

40− let tagName = TH.mkName strTagName

41− tag = TH.conT tagName

42− tagProxyName = TH.mkName strTagProxyName

43− tagDecl <- emptyDataDecl tagName

44− (tagProxySig, tagProxyVal) <- proxySimple tagProxyName tag

45− return [tagDecl, tagProxySig, tagProxyVal]

13+tag :: TH.QuasiQuoter

14+tag = TH.QuasiQuoter proxyExpQ undefined undefined undefined

15+ where

16+ proxyExpQ :: String -> TH.ExpQ

17+ proxyExpQ nameStr =

18+ let ty = TH.conT (TH.mkName nameStr)

19+ in [e| proxy# :: Proxy# $ty |]

src/Control/Monad/Ether.hs+1−1

@@ -11,4 +11,4 @@ import Control.Monad.Ether.Writer as X

1111import Control.Monad.Ether.State as X

1212import Control.Monad.Ether.Except as X

1313import Control.Monad.Trans.Ether.Dispatch as X

14−import Control.Ether.TH as X (ethereal)

14+import Control.Ether.TH as X (tag)

src/Control/Monad/Ether/Except.hs+4−2

@@ -1,3 +1,4 @@

1+{-# LANGUAGE MagicHash #-}

23-- | See "Control.Monad.Except".

@@ -17,14 +18,15 @@ module Control.Monad.Ether.Except

1718 , handle

1819 ) where

1920

21+import GHC.Prim (Proxy#)

2022import Control.Monad.Ether.Except.Class

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

2224import Data.Functor.Identity (Identity(..))

2325

2426-- | Runs an 'Except' and handles the exception with the given function.

25−handle :: proxy tag -> (e -> a) -> Except tag e a -> a

27+handle :: Proxy# tag -> (e -> a) -> Except tag e a -> a

2628handle t h m = runIdentity (handleT t h m)

2729

2830-- | Runs an 'ExceptT' and handles the exception with the given function.

29−handleT :: Functor m => proxy tag -> (e -> a) -> ExceptT tag e m a -> m a

31+handleT :: Functor m => Proxy# tag -> (e -> a) -> ExceptT tag e m a -> m a

3032handleT t h m = fmap (either h id) (runExceptT t m)

src/Control/Monad/Ether/Except/Class.hs+4−3

@@ -11,6 +11,7 @@

1111{-# LANGUAGE FunctionalDependencies #-}

1212{-# LANGUAGE TypeFamilies #-}

1313{-# LANGUAGE PolyKinds #-}

14+{-# LANGUAGE MagicHash #-}

1415

1516-- | See "Control.Monad.Except".

1617

@@ -18,19 +19,19 @@ module Control.Monad.Ether.Except.Class

1819 ( MonadExcept(..)

1920 ) where

2021

22+import GHC.Prim (Proxy#)

2123import qualified Control.Monad.Trans.Ether.Except as E

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

2325

24−

2526-- | See 'Control.Monad.Except.MonadError'.

2627class Monad m => MonadExcept tag e m | m tag -> e where

2728

2829 -- | Is used within a monadic computation to begin exception processing.

29− throw :: proxy tag -> e -> m a

30+ throw :: Proxy# tag -> e -> m a

3031

3132 -- | A handler function to handle previous exceptions and return to

3233 -- normal execution.

33− catch :: proxy tag -> m a -> (e -> m a) -> m a

34+ catch :: Proxy# tag -> m a -> (e -> m a) -> m a

3435

3536instance (Monad m, e ~ e') => MonadExcept tag e (E.ExceptT tag e' m) where

3637 throw = E.throw

src/Control/Monad/Ether/Implicit.hs−1

@@ -11,4 +11,3 @@ import Control.Monad.Ether.Implicit.Writer as X

1111import Control.Monad.Ether.Implicit.State as X

1212import Control.Monad.Ether.Implicit.Except as X

1313import Control.Monad.Trans.Ether.Dispatch as X

14−import Control.Ether.TH as X (ethereal)

src/Control/Monad/Ether/Implicit/Except.hs+9−8

@@ -1,5 +1,6 @@

11{-# LANGUAGE ConstraintKinds #-}

22{-# LANGUAGE ScopedTypeVariables #-}

3+{-# LANGUAGE MagicHash #-}

45-- | See "Control.Monad.Ether.Except".

@@ -21,7 +22,7 @@ module Control.Monad.Ether.Implicit.Except

2122 , handleT

2223 ) where

2324

24−import Data.Proxy

25+import GHC.Prim (Proxy#, proxy#)

2526import qualified Control.Monad.Ether.Except as Explicit

2627

2728-- | See 'Control.Monad.Ether.Except.MonadExcept'.

@@ -29,34 +30,34 @@ type MonadExcept e = Explicit.MonadExcept e e

2930

3031-- | See 'Control.Monad.Ether.Except.throw'.

3132throw :: forall e m a . MonadExcept e m => e -> m a

32−throw = Explicit.throw (Proxy :: Proxy e)

33+throw = Explicit.throw (proxy# :: Proxy# e)

3334

3435-- | See 'Control.Monad.Ether.Except.catch'.

3536catch :: forall e m a . MonadExcept e m => m a -> (e -> m a) -> m a

36−catch = Explicit.catch (Proxy :: Proxy e)

37+catch = Explicit.catch (proxy# :: Proxy# e)

3738

3839-- | See 'Control.Monad.Ether.Except.Except'.

3940type Except e = Explicit.Except e e

4041

4142-- | See 'Control.Monad.Ether.Except.runExcept'.

4243runExcept :: Except e a -> Either e a

43−runExcept = Explicit.runExcept Proxy

44+runExcept = Explicit.runExcept proxy#

4445

4546-- | See 'Control.Monad.Ether.Except.ExceptT'.

4647type ExceptT e = Explicit.ExceptT e e

4748

4849-- | See 'Control.Monad.Ether.Except.exceptT'.

4950exceptT :: m (Either e a) -> ExceptT e m a

50−exceptT = Explicit.exceptT Proxy

51+exceptT = Explicit.exceptT proxy#

5152

5253-- | See 'Control.Monad.Ether.Except.runExceptT'.

5354runExceptT :: ExceptT e m a -> m (Either e a)

54−runExceptT = Explicit.runExceptT Proxy

55+runExceptT = Explicit.runExceptT proxy#

5556

5657-- | See 'Control.Monad.Ether.Except.handle'.

5758handle :: (e -> a) -> Except e a -> a

58−handle = Explicit.handle Proxy

59+handle = Explicit.handle proxy#

5960

6061-- | See 'Control.Monad.Ether.Except.handleT'.

6162handleT :: Functor m => (e -> a) -> ExceptT e m a -> m a

62−handleT = Explicit.handleT Proxy

63+handleT = Explicit.handleT proxy#

src/Control/Monad/Ether/Implicit/Reader.hs+9−8

@@ -1,5 +1,6 @@

11{-# LANGUAGE ConstraintKinds #-}

22{-# LANGUAGE ScopedTypeVariables #-}

3+{-# LANGUAGE MagicHash #-}

45-- | See "Control.Monad.Ether.Reader".

@@ -20,7 +21,7 @@ module Control.Monad.Ether.Implicit.Reader

2021 , runReaderT

2122 ) where

2223

23−import Data.Proxy

24+import GHC.Prim (Proxy#, proxy#)

2425import qualified Control.Monad.Ether.Reader as Explicit

2526

2627-- | See 'Control.Monad.Ether.Reader.ReaderT'.

@@ -31,31 +32,31 @@ type Reader r = Explicit.Reader r r

3132

3233-- | See 'Control.Monad.Ether.Reader.readerT'.

3334readerT :: (r -> m a) -> ReaderT r m a

34−readerT = Explicit.readerT Proxy

35+readerT = Explicit.readerT proxy#

3536

3637-- | See 'Control.Monad.Ether.Reader.runReaderT'.

3738runReaderT :: ReaderT r m a -> r -> m a

38−runReaderT = Explicit.runReaderT Proxy

39+runReaderT = Explicit.runReaderT proxy#

3940

4041-- | See 'Control.Monad.Ether.Reader.runReader'.

4142runReader :: Reader r a -> r -> a

42−runReader = Explicit.runReader Proxy

43+runReader = Explicit.runReader proxy#

4344

4445-- | See 'Control.Monad.Ether.Reader.MonadReader'.

4546type MonadReader r = Explicit.MonadReader r r

4647

4748-- | See 'Control.Monad.Ether.Reader.local'.

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

49−local = Explicit.local (Proxy :: Proxy r)

50+local = Explicit.local (proxy# :: Proxy# r)

5051

5152-- | See 'Control.Monad.Ether.Reader.ask'.

5253ask :: forall r m . MonadReader r m => m r

53−ask = Explicit.ask (Proxy :: Proxy r)

54+ask = Explicit.ask (proxy# :: Proxy# r)

5455

5556-- | See 'Control.Monad.Ether.Reader.reader'.

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

57−reader = Explicit.reader (Proxy :: Proxy r)

58+reader = Explicit.reader (proxy# :: Proxy# r)

5859

5960-- | See 'Control.Monad.Ether.Reader.asks'.

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

61−asks = Explicit.asks (Proxy :: Proxy r)

62+asks = Explicit.asks (proxy# :: Proxy# r)

src/Control/Monad/Ether/Implicit/State/Lazy.hs+14−13

@@ -1,5 +1,6 @@

11{-# LANGUAGE ConstraintKinds #-}

22{-# LANGUAGE ScopedTypeVariables #-}

3+{-# LANGUAGE MagicHash #-}

45-- | See "Control.Monad.Ether.State.Lazy".

@@ -25,7 +26,7 @@ module Control.Monad.Ether.Implicit.State.Lazy

2526 , execStateT

2627 ) where

2728

28−import Data.Proxy

29+import GHC.Prim (Proxy#, proxy#)

2930import qualified Control.Monad.Ether.State.Lazy as Explicit

3031

3132-- | See 'Control.Monad.Ether.State.Lazy.StateT'.

@@ -36,51 +37,51 @@ type State s = Explicit.State s s

3637

3738-- | See 'Control.Monad.Ether.State.Lazy.stateT'.

3839stateT :: (s -> m (a, s)) -> StateT s m a

39−stateT = Explicit.stateT Proxy

40+stateT = Explicit.stateT proxy#

4041

4142-- | See 'Control.Monad.Ether.State.Lazy.runStateT'.

4243runStateT :: StateT s m a -> s -> m (a, s)

43−runStateT = Explicit.runStateT Proxy

44+runStateT = Explicit.runStateT proxy#

4445

4546-- | See 'Control.Monad.Ether.State.Lazy.runState'.

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

47−runState = Explicit.runState Proxy

48+runState = Explicit.runState proxy#

4849

4950-- | See 'Control.Monad.Ether.State.Lazy.evalStateT'.

5051evalStateT :: Monad m => StateT s m a -> s -> m a

51−evalStateT = Explicit.evalStateT Proxy

52+evalStateT = Explicit.evalStateT proxy#

5253

5354-- | See 'Control.Monad.Ether.State.Lazy.evalState'.

5455evalState :: State s a -> s -> a

55−evalState = Explicit.evalState Proxy

56+evalState = Explicit.evalState proxy#

5657

5758-- | See 'Control.Monad.Ether.State.Lazy.execStateT'.

5859execStateT :: Monad m => StateT s m a -> s -> m s

59−execStateT = Explicit.execStateT Proxy

60+execStateT = Explicit.execStateT proxy#

6061

6162-- | See 'Control.Monad.Ether.State.Lazy.execState'.

6263execState :: State s a -> s -> s

63−execState = Explicit.execState Proxy

64+execState = Explicit.execState proxy#

6465

6566-- | See 'Control.Monad.Ether.State.Lazy.MonadState'.

6667type MonadState s = Explicit.MonadState s s

6768

6869-- | See 'Control.Monad.Ether.State.Lazy.get'.

6970get :: forall s m . MonadState s m => m s

70−get = Explicit.get (Proxy :: Proxy s)

71+get = Explicit.get (proxy# :: Proxy# s)

7172

7273-- | See 'Control.Monad.Ether.State.Lazy.gets'.

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

74−gets = Explicit.gets (Proxy :: Proxy s)

75+gets = Explicit.gets (proxy# :: Proxy# s)

7576

7677-- | See 'Control.Monad.Ether.State.Lazy.put'.

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

78−put = Explicit.put (Proxy :: Proxy s)

79+put = Explicit.put (proxy# :: Proxy# s)

7980

8081-- | See 'Control.Monad.Ether.State.Lazy.state'.

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

82−state = Explicit.state (Proxy :: Proxy s)

83+state = Explicit.state (proxy# :: Proxy# s)

8384

8485-- | See 'Control.Monad.Ether.State.Lazy.modify'.

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

86−modify = Explicit.modify (Proxy :: Proxy s)

87+modify = Explicit.modify (proxy# :: Proxy# s)

src/Control/Monad/Ether/Implicit/State/Strict.hs+14−13

@@ -1,5 +1,6 @@

11{-# LANGUAGE ConstraintKinds #-}

22{-# LANGUAGE ScopedTypeVariables #-}

3+{-# LANGUAGE MagicHash #-}

45-- | See "Control.Monad.Ether.State.Strict".

@@ -25,7 +26,7 @@ module Control.Monad.Ether.Implicit.State.Strict

2526 , execStateT

2627 ) where

2728

28−import Data.Proxy

29+import GHC.Prim (Proxy#, proxy#)

2930import qualified Control.Monad.Ether.State.Strict as Explicit

3031

3132-- | See 'Control.Monad.Ether.State.Strict.StateT'.

@@ -36,51 +37,51 @@ type State s = Explicit.State s s

3637

3738-- | See 'Control.Monad.Ether.State.Strict.stateT'.

3839stateT :: (s -> m (a, s)) -> StateT s m a

39−stateT = Explicit.stateT Proxy

40+stateT = Explicit.stateT proxy#

4041

4142-- | See 'Control.Monad.Ether.State.Strict.runStateT'.

4243runStateT :: StateT s m a -> s -> m (a, s)

43−runStateT = Explicit.runStateT Proxy

44+runStateT = Explicit.runStateT proxy#

4445

4546-- | See 'Control.Monad.Ether.State.Strict.runState'.

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

47−runState = Explicit.runState Proxy

48+runState = Explicit.runState proxy#

4849

4950-- | See 'Control.Monad.Ether.State.Strict.evalStateT'.

5051evalStateT :: Monad m => StateT s m a -> s -> m a

51−evalStateT = Explicit.evalStateT Proxy

52+evalStateT = Explicit.evalStateT proxy#

5253

5354-- | See 'Control.Monad.Ether.State.Strict.evalState'.

5455evalState :: State s a -> s -> a

55−evalState = Explicit.evalState Proxy

56+evalState = Explicit.evalState proxy#

5657

5758-- | See 'Control.Monad.Ether.State.Strict.execStateT'.

5859execStateT :: Monad m => StateT s m a -> s -> m s

59−execStateT = Explicit.execStateT Proxy

60+execStateT = Explicit.execStateT proxy#

6061

6162-- | See 'Control.Monad.Ether.State.Strict.execState'.

6263execState :: State s a -> s -> s

63−execState = Explicit.execState Proxy

64+execState = Explicit.execState proxy#

6465

6566-- | See 'Control.Monad.Ether.State.Strict.MonadState'.

6667type MonadState s = Explicit.MonadState s s

6768

6869-- | See 'Control.Monad.Ether.State.Strict.get'.

6970get :: forall s m . MonadState s m => m s

70−get = Explicit.get (Proxy :: Proxy s)

71+get = Explicit.get (proxy# :: Proxy# s)

7172

7273-- | See 'Control.Monad.Ether.State.Strict.gets'.

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

74−gets = Explicit.gets (Proxy :: Proxy s)

75+gets = Explicit.gets (proxy# :: Proxy# s)

7576

7677-- | See 'Control.Monad.Ether.State.Strict.put'.

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

78−put = Explicit.put (Proxy :: Proxy s)

79+put = Explicit.put (proxy# :: Proxy# s)

7980

8081-- | See 'Control.Monad.Ether.State.Strict.state'.

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

82−state = Explicit.state (Proxy :: Proxy s)

83+state = Explicit.state (proxy# :: Proxy# s)

8384

8485-- | See 'Control.Monad.Ether.State.Strict.modify'.

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

86−modify = Explicit.modify (Proxy :: Proxy s)

87+modify = Explicit.modify (proxy# :: Proxy# s)

src/Control/Monad/Ether/Implicit/Writer.hs+13−12

@@ -1,5 +1,6 @@

11{-# LANGUAGE ConstraintKinds #-}

22{-# LANGUAGE ScopedTypeVariables #-}

3+{-# LANGUAGE MagicHash #-}

45-- | See "Control.Monad.Ether.Writer".

@@ -24,7 +25,7 @@ module Control.Monad.Ether.Implicit.Writer

2425 , execWriterT

2526 ) where

2627

27−import Data.Proxy

28+import GHC.Prim (Proxy#, proxy#)

2829import qualified Control.Monad.Ether.Writer as Explicit

2930

3031-- | See 'Control.Monad.Ether.Writer.MonadWriter'.

@@ -32,50 +33,50 @@ type MonadWriter w = Explicit.MonadWriter w w

3233

3334-- | See 'Control.Monad.Ether.Writer.writer'.

3435writer :: forall w m a . MonadWriter w m => (a, w) -> m a

35−writer = Explicit.writer (Proxy :: Proxy w)

36+writer = Explicit.writer (proxy# :: Proxy# w)

3637

3738-- | See 'Control.Monad.Ether.Writer.tell'.

3839tell :: forall w m . MonadWriter w m => w -> m ()

39−tell = Explicit.tell (Proxy :: Proxy w)

40+tell = Explicit.tell (proxy# :: Proxy# w)

4041

4142-- | See 'Control.Monad.Ether.Writer.listen'.

4243listen :: forall w m a . MonadWriter w m => m a -> m (a, w)

43−listen = Explicit.listen (Proxy :: Proxy w)

44+listen = Explicit.listen (proxy# :: Proxy# w)

4445

4546-- | See 'Control.Monad.Ether.Writer.pass'.

4647pass :: forall w m a . MonadWriter w m => m (a, w -> w) -> m a

47−pass = Explicit.pass (Proxy :: Proxy w)

48+pass = Explicit.pass (proxy# :: Proxy# w)

4849

4950-- | See 'Control.Monad.Ether.Writer.listens'.

5051listens :: forall w m a b . MonadWriter w m => (w -> b) -> m a -> m (a, b)

51−listens = Explicit.listens (Proxy :: Proxy w)

52+listens = Explicit.listens (proxy# :: Proxy# w)

5253

5354-- | See 'Control.Monad.Ether.Writer.censor'.

5455censor :: forall w m a . MonadWriter w m => (w -> w) -> m a -> m a

55−censor = Explicit.censor (Proxy :: Proxy w)

56+censor = Explicit.censor (proxy# :: Proxy# w)

5657

5758-- | See 'Control.Monad.Ether.Writer.Writer'.

5859type Writer w = Explicit.Writer w w

5960

6061-- | See 'Control.Monad.Ether.Writer.runWriter'.

6162runWriter :: Writer w a -> (a, w)

62−runWriter = Explicit.runWriter Proxy

63+runWriter = Explicit.runWriter proxy#

6364

6465-- | See 'Control.Monad.Ether.Writer.execWriter'.

6566execWriter :: Writer w a -> w

66−execWriter = Explicit.execWriter Proxy

67+execWriter = Explicit.execWriter proxy#

6768

6869-- | See 'Control.Monad.Ether.Writer.WriterT'.

6970type WriterT w = Explicit.WriterT w w

7071

7172-- | See 'Control.Monad.Ether.Writer.writerT'.

7273writerT :: m (a, w) -> WriterT w m a

73−writerT = Explicit.writerT Proxy

74+writerT = Explicit.writerT proxy#

7475

7576-- | See 'Control.Monad.Ether.Writer.runWriterT'.

7677runWriterT :: WriterT w m a -> m (a, w)

77−runWriterT = Explicit.runWriterT Proxy

78+runWriterT = Explicit.runWriterT proxy#

7879

7980-- | See 'Control.Monad.Ether.Writer.execWriterT'.

8081execWriterT :: Monad m => WriterT w m a -> m w

81−execWriterT = Explicit.execWriterT Proxy

82+execWriterT = Explicit.execWriterT proxy#

src/Control/Monad/Ether/Reader/Class.hs+6−4

@@ -11,6 +11,7 @@

1111{-# LANGUAGE FunctionalDependencies #-}

1212{-# LANGUAGE TypeFamilies #-}

1313{-# LANGUAGE PolyKinds #-}

14+{-# LANGUAGE MagicHash #-}

1415

1516-- | See "Control.Monad.Reader.Class".

1617

@@ -19,6 +20,7 @@ module Control.Monad.Ether.Reader.Class

1920 , asks

2021 ) where

2122

23+import GHC.Prim (Proxy#)

2224import qualified Control.Monad.Trans.Ether.Reader as R

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

2426import qualified Control.Ether.Util as Util

@@ -29,12 +31,12 @@ class Monad m => MonadReader tag r m | m tag -> r where

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

3032

3133 -- | Retrieves the monad environment.

32− ask :: proxy tag -> m r

34+ ask :: Proxy# tag -> m r

3335 ask t = reader t id

3436

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

3638 local

37− :: proxy tag

39+ :: Proxy# tag

3840 -> (r -> r)

3941 -- ^ The function to modify the environment.

4042 -> m a

@@ -43,7 +45,7 @@ class Monad m => MonadReader tag r m | m tag -> r where

4345

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

4547 reader

46− :: proxy tag

48+ :: Proxy# tag

4749 -> (r -> a)

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

4951 -> m a

@@ -52,7 +54,7 @@ class Monad m => MonadReader tag r m | m tag -> r where

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

5355asks

5456 :: MonadReader tag r m

55− => proxy tag

57+ => Proxy# tag

5658 -> (r -> a)

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

5860 -> m a

src/Control/Monad/Ether/State/Class.hs+7−5

@@ -11,6 +11,7 @@

1111{-# LANGUAGE FunctionalDependencies #-}

1212{-# LANGUAGE TypeFamilies #-}

1313{-# LANGUAGE PolyKinds #-}

14+{-# LANGUAGE MagicHash #-}

1415

1516-- | See "Control.Monad.State.Class".

1617

@@ -20,6 +21,7 @@ module Control.Monad.Ether.State.Class

2021 , gets

2122 ) where

2223

24+import GHC.Prim (Proxy#)

2325import qualified Control.Monad.Trans.Ether.State.Lazy as S.L

2426import qualified Control.Monad.Trans.Ether.State.Strict as S.S

2527import qualified Control.Monad.Trans as Lift

@@ -31,15 +33,15 @@ class Monad m => MonadState tag s m | m tag -> s where

3133 {-# MINIMAL state | get, put #-}

3234

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

34− get :: proxy tag -> m s

36+ get :: Proxy# tag -> m s

3537 get t = state t (\s -> (s, s))

3638

3739 -- | Replace the state inside the monad.

38− put :: proxy tag -> s -> m ()

40+ put :: Proxy# tag -> s -> m ()

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

4042

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

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

44+ state :: Proxy# tag -> (s -> (a, s)) -> m a

4345 state t f = do

4446 s <- get t

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

@@ -47,11 +49,11 @@ class Monad m => MonadState tag s m | m tag -> s where

4749 return a

4850

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

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

52+modify :: MonadState tag s m => Proxy# tag -> (s -> s) -> m ()

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

5254

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

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

56+gets :: MonadState tag s m => Proxy# tag -> (s -> a) -> m a

5557gets t f = Util.fmap f (get t)

5658

5759instance (Monad m, s ~ s') => MonadState tag s (S.L.StateT tag s' m) where

src/Control/Monad/Ether/Writer/Class.hs+8−6

@@ -11,6 +11,7 @@

1111{-# LANGUAGE FunctionalDependencies #-}

1212{-# LANGUAGE TypeFamilies #-}

1313{-# LANGUAGE PolyKinds #-}

14+{-# LANGUAGE MagicHash #-}

1415

1516-- | See "Control.Monad.Writer.Class".

1617

@@ -24,6 +25,7 @@ module Control.Monad.Ether.Writer.Class

2425import Data.Monoid

2526#endif

2627

28+import GHC.Prim (Proxy#)

2729import qualified Control.Monad.Trans.Ether.Writer as W

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

2931import qualified Control.Monad.Trans.Lift.Pass as Lift

@@ -34,32 +36,32 @@ class (Monoid w, Monad m) => MonadWriter tag w m | m tag -> w where

3436 {-# MINIMAL (writer | tell), listen, pass #-}

3537

3638 -- | Embed a simple writer action.

37− writer :: proxy tag -> (a, w) -> m a

39+ writer :: Proxy# tag -> (a, w) -> m a

3840 writer t ~(a, w) = do

3941 tell t w

4042 return a

4143

4244 -- | Append a value to the accumulator within the monad.

43− tell :: proxy tag -> w -> m ()

45+ tell :: Proxy# tag -> w -> m ()

4446 tell t w = writer t ((),w)

4547

4648 -- | Execute an action and add its accumulator

4749 -- to the value of the computation.

48− listen :: proxy tag -> m a -> m (a, w)

50+ listen :: Proxy# tag -> m a -> m (a, w)

4951

5052 -- | Execute an action which returns a value and a function,

5153 -- and return the value, applying the function to the accumulator.

52− pass :: proxy tag -> m (a, w -> w) -> m a

54+ pass :: Proxy# tag -> m (a, w -> w) -> m a

5355

5456-- | Execute an action and add the result of applying the given function to

5557-- its accumulator to the value of the computation.

56−listens :: MonadWriter tag w m => proxy tag -> (w -> b) -> m a -> m (a, b)

58+listens :: MonadWriter tag w m => Proxy# tag -> (w -> b) -> m a -> m (a, b)

5759listens t f m = do

5860 ~(a, w) <- listen t m

5961 return (a, f w)

6062

6163-- | Execute an action and apply a function to its accumulator.

62−censor :: MonadWriter tag w m => proxy tag -> (w -> w) -> m a -> m a

64+censor :: MonadWriter tag w m => Proxy# tag -> (w -> w) -> m a -> m a

6365censor t f m = pass t $ do

6466 a <- m

6567 return (a, f)

src/Control/Monad/Trans/Ether/Dispatch.hs+25−24

@@ -13,6 +13,7 @@

1313{-# LANGUAGE DataKinds #-}

1414{-# LANGUAGE PolyKinds #-}

1515{-# LANGUAGE GeneralizedNewtypeDeriving #-}

16+{-# LANGUAGE MagicHash #-}

1617

1718{- |

1819

@@ -66,7 +67,7 @@ import Control.Monad.Morph (MFunctor, MMonad)

6667import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)

6768import GHC.Generics (Generic)

6869import Data.Coerce (coerce)

69−import Data.Proxy

70+import GHC.Prim (Proxy#, proxy#)

7071

7172import qualified Control.Monad.Base as MB

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

@@ -147,13 +148,13 @@ instance Lift.LiftCallCC (DispatchT dp) where

147148 liftCallCC' = Lift.defaultLiftCallCC' pack unpack

148149

149150-- | Attach a tag to untagged transformers.

150−tagAttach :: proxy t -> DispatchTagAttachT t m a -> m a

151+tagAttach :: Proxy# t -> DispatchTagAttachT t m a -> m a

151152tagAttach _ = coerce

152153

153154-- | Replace a tag with another tag.

154155tagReplace

155− :: proxy tOld

156− -> proxy tNew

156+ :: Proxy# tOld

157+ -> Proxy# tNew

157158 -> DispatchTagReplaceT tOld tNew m a

158159 -> m a

159160tagReplace _ _ = coerce

@@ -163,47 +164,47 @@ tagReplace _ _ = coerce

163164

164165instance MonadReader tag r m

165166 => Class.MonadReader r (DispatchTagAttachT tag m) where

166− ask = let t = Proxy :: Proxy tag in Lift.lift (ask t)

167− local = let t = Proxy :: Proxy tag in Lift.liftLocal (ask t) (local t)

167+ ask = let t = proxy# :: Proxy# tag in Lift.lift (ask t)

168+ local = let t = proxy# :: Proxy# tag in Lift.liftLocal (ask t) (local t)

168169

169170instance MonadState tag s m

170171 => Class.MonadState s (DispatchTagAttachT tag m) where

171− get = let t = Proxy :: Proxy tag in Lift.lift (get t)

172− put = let t = Proxy :: Proxy tag in Lift.lift . put t

172+ get = let t = proxy# :: Proxy# tag in Lift.lift (get t)

173+ put = let t = proxy# :: Proxy# tag in Lift.lift . put t

173174

174175instance MonadExcept tag e m

175176 => Class.MonadError e (DispatchTagAttachT tag m) where

176− throwError = let t = Proxy :: Proxy tag in Lift.lift . throw t

177− catchError = let t = Proxy :: Proxy tag in Lift.liftCatch (catch t)

177+ throwError = let t = proxy# :: Proxy# tag in Lift.lift . throw t

178+ catchError = let t = proxy# :: Proxy# tag in Lift.liftCatch (catch t)

178179

179180instance MonadWriter tag w m

180181 => Class.MonadWriter w (DispatchTagAttachT tag m) where

181− writer = let t = Proxy :: Proxy tag in Lift.lift . writer t

182− tell = let t = Proxy :: Proxy tag in Lift.lift . tell t

183− listen = let t = Proxy :: Proxy tag in Lift.liftListen (listen t)

184− pass = let t = Proxy :: Proxy tag in Lift.liftPass (pass t)

182+ writer = let t = proxy# :: Proxy# tag in Lift.lift . writer t

183+ tell = let t = proxy# :: Proxy# tag in Lift.lift . tell t

184+ listen = let t = proxy# :: Proxy# tag in Lift.liftListen (listen t)

185+ pass = let t = proxy# :: Proxy# tag in Lift.liftPass (pass t)

185186

186187

187188-- TagReplace instances

188189

189190instance MonadReader tNew r m

190191 => MonadReader tOld r (DispatchTagReplaceT tOld tNew m) where

191− ask _ = let t = Proxy :: Proxy tNew in Lift.lift (ask t)

192− local _ = let t = Proxy :: Proxy tNew in Lift.liftLocal (ask t) (local t)

192+ ask _ = let t = proxy# :: Proxy# tNew in Lift.lift (ask t)

193+ local _ = let t = proxy# :: Proxy# tNew in Lift.liftLocal (ask t) (local t)

193194

194195instance MonadState tNew s m

195196 => MonadState tOld s (DispatchTagReplaceT tOld tNew m) where

196− get _ = let t = Proxy :: Proxy tNew in Lift.lift (get t)

197− put _ = let t = Proxy :: Proxy tNew in Lift.lift . put t

197+ get _ = let t = proxy# :: Proxy# tNew in Lift.lift (get t)

198+ put _ = let t = proxy# :: Proxy# tNew in Lift.lift . put t

198199

199200instance MonadExcept tNew e m

200201 => MonadExcept tOld e (DispatchTagReplaceT tOld tNew m) where

201− throw _ = let t = Proxy :: Proxy tNew in Lift.lift . throw t

202− catch _ = let t = Proxy :: Proxy tNew in Lift.liftCatch (catch t)

202+ throw _ = let t = proxy# :: Proxy# tNew in Lift.lift . throw t

203+ catch _ = let t = proxy# :: Proxy# tNew in Lift.liftCatch (catch t)

203204

204205instance MonadWriter tNew w m

205206 => MonadWriter tOld w (DispatchTagReplaceT tOld tNew m) where

206− writer _ = let t = Proxy :: Proxy tNew in Lift.lift . writer t

207− tell _ = let t = Proxy :: Proxy tNew in Lift.lift . tell t

208− listen _ = let t = Proxy :: Proxy tNew in Lift.liftListen (listen t)

209− pass _ = let t = Proxy :: Proxy tNew in Lift.liftPass (pass t)

207+ writer _ = let t = proxy# :: Proxy# tNew in Lift.lift . writer t

208+ tell _ = let t = proxy# :: Proxy# tNew in Lift.lift . tell t

209+ listen _ = let t = proxy# :: Proxy# tNew in Lift.liftListen (listen t)

210+ pass _ = let t = proxy# :: Proxy# tNew in Lift.liftPass (pass t)

src/Control/Monad/Trans/Ether/Except.hs+8−6

@@ -6,6 +6,7 @@

66{-# LANGUAGE DataKinds #-}

77{-# LANGUAGE PolyKinds #-}

88{-# LANGUAGE GeneralizedNewtypeDeriving #-}

9+{-# LANGUAGE MagicHash #-}

910

1011-- | See "Control.Monad.Trans.Except".

1112

@@ -24,6 +25,7 @@ module Control.Monad.Trans.Ether.Except

2425 , catch

2526 ) where

2627

28+import GHC.Prim (Proxy#)

2729import Data.Functor.Identity (Identity(..))

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

2931import Control.Monad.Trans.Ether.Tagged

@@ -38,7 +40,7 @@ import Control.Monad.Trans.Ether.Tagged

3840type Except tag e = ExceptT tag e Identity

3941

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

41−runExcept :: proxy tag -> Except tag e a -> Either e a

43+runExcept :: Proxy# tag -> Except tag e a -> Either e a

4244runExcept _ = Trans.runExcept . unpack

4345

4446-- | The exception monad transformer.

@@ -48,22 +50,22 @@ runExcept _ = Trans.runExcept . unpack

4850type ExceptT tag e = TaggedTrans tag (Trans.ExceptT e)

4951

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

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

53+exceptT :: Proxy# tag -> m (Either e a) -> ExceptT tag e m a

5254exceptT _ = pack . Trans.ExceptT

5355

5456-- | Constructor for computations in the exception monad

5557-- (the inverse of 'runExcept').

56−except :: Monad m => proxy tag -> Either e a -> ExceptT tag e m a

58+except :: Monad m => Proxy# tag -> Either e a -> ExceptT tag e m a

5759except t = exceptT t . return

5860

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

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

62+runExceptT :: Proxy# tag -> ExceptT tag e m a -> m (Either e a)

6163runExceptT _ = Trans.runExceptT . unpack

6264

6365-- | Is used within a monadic computation to begin exception processing.

64−throw :: Monad m => proxy tag -> e -> ExceptT tag e m a

66+throw :: Monad m => Proxy# tag -> e -> ExceptT tag e m a

6567throw _ = pack . Trans.throwE

6668

6769-- | A handler function to handle previous exceptions and return to normal execution.

68−catch :: Monad m => proxy tag -> ExceptT tag e m a -> (e -> ExceptT tag e m a) -> ExceptT tag e m a

70+catch :: Monad m => Proxy# tag -> ExceptT tag e m a -> (e -> ExceptT tag e m a) -> ExceptT tag e m a

6971catch _ m h = pack $ Trans.catchE (unpack m) (unpack . h)

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

@@ -6,6 +6,7 @@

66{-# LANGUAGE DataKinds #-}

77{-# LANGUAGE PolyKinds #-}

88{-# LANGUAGE GeneralizedNewtypeDeriving #-}

9+{-# LANGUAGE MagicHash #-}

910

1011-- | See "Control.Monad.Trans.Reader".

1112

@@ -24,6 +25,7 @@ module Control.Monad.Trans.Ether.Reader

2425 , local

2526 ) where

2627

28+import GHC.Prim (Proxy#)

2729import Data.Functor.Identity (Identity(..))

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

2931import Control.Monad.Trans.Ether.Tagged

@@ -44,26 +46,26 @@ type Reader tag r = ReaderT tag r Identity

4446type ReaderT tag r = TaggedTrans tag (Trans.ReaderT r)

4547

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

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

49+readerT :: Proxy# tag -> (r -> m a) -> ReaderT tag r m a

4850readerT _ = pack . Trans.ReaderT

4951

5052-- | Constructor for computations in the reader monad

5153-- (the inverse of 'runReader').

52−reader :: Monad m => proxy tag -> (r -> a) -> ReaderT tag r m a

54+reader :: Monad m => Proxy# tag -> (r -> a) -> ReaderT tag r m a

5355reader _ = pack . Trans.reader

5456

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

5658-- and returns the final value.

57−runReaderT :: proxy tag -> ReaderT tag r m a -> r -> m a

59+runReaderT :: Proxy# tag -> ReaderT tag r m a -> r -> m a

5860runReaderT _ = Trans.runReaderT . unpack

5961

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

6163-- and returns the final value.

62−runReader :: proxy tag -> Reader tag r a -> r -> a

64+runReader :: Proxy# tag -> Reader tag r a -> r -> a

6365runReader _ = Trans.runReader . unpack

6466

6567-- | Fetch the value of the environment.

66−ask :: Monad m => proxy tag -> ReaderT tag r m r

68+ask :: Monad m => Proxy# tag -> ReaderT tag r m r

6769ask _ = pack Trans.ask

6870

6971-- | Execute a computation in a modified environment

@@ -71,7 +73,7 @@ ask _ = pack Trans.ask

7173--

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

7375local

74− :: proxy tag

76+ :: Proxy# tag

7577 -> (r -> r)

7678 -- ^ The function to modify the environment.

7779 -> ReaderT tag r m a

src/Control/Monad/Trans/Ether/State/Lazy.hs+12−10

@@ -6,6 +6,7 @@

66{-# LANGUAGE DataKinds #-}

77{-# LANGUAGE PolyKinds #-}

88{-# LANGUAGE GeneralizedNewtypeDeriving #-}

9+{-# LANGUAGE MagicHash #-}

910

1011-- | See "Control.Monad.Trans.State.Lazy".

1112

@@ -28,6 +29,7 @@ module Control.Monad.Trans.Ether.State.Lazy

2829 , put

2930 ) where

3031

32+import GHC.Prim (Proxy#)

3133import Data.Functor.Identity (Identity(..))

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

3335import Control.Monad.Trans.Ether.Tagged

@@ -47,48 +49,48 @@ type State tag r = StateT tag r Identity

4749type StateT tag s = TaggedTrans tag (Trans.StateT s)

4850

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

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

52+stateT :: Proxy# tag -> (s -> m (a, s)) -> StateT tag s m a

5153stateT _ = pack . Trans.StateT

5254

5355-- | Constructor for computations in the state monad

5456-- (the inverse of 'runState').

55−state :: Monad m => proxy tag -> (s -> (a, s)) -> StateT tag s m a

57+state :: Monad m => Proxy# tag -> (s -> (a, s)) -> StateT tag s m a

5658state _ = pack . Trans.state

5759

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

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

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

62+runStateT :: Proxy# tag -> StateT tag s m a -> s -> m (a, s)

6163runStateT _ = Trans.runStateT . unpack

6264

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

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

65−evalStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m a

67+evalStateT :: Monad m => Proxy# tag -> StateT tag s m a -> s -> m a

6668evalStateT _ = Trans.evalStateT . unpack

6769

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

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

70−execStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m s

72+execStateT :: Monad m => Proxy# tag -> StateT tag s m a -> s -> m s

7173execStateT _ = Trans.execStateT . unpack

7274

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

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

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

77+runState :: Proxy# tag -> State tag s a -> s -> (a, s)

7678runState _ = Trans.runState . unpack

7779

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

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

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

82+evalState :: Proxy# tag -> State tag s a -> s -> a

8183evalState _ = Trans.evalState . unpack

8284

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

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

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

87+execState :: Proxy# tag -> State tag s a -> s -> s

8688execState _ = Trans.execState . unpack

8789

8890-- | Fetch the current value of the state within the monad.

89−get :: Monad m => proxy tag -> StateT tag s m s

91+get :: Monad m => Proxy# tag -> StateT tag s m s

9092get _ = pack Trans.get

9193

9294-- | Set the value of the state within the monad.

93−put :: Monad m => proxy tag -> s -> StateT tag s m ()

95+put :: Monad m => Proxy# tag -> s -> StateT tag s m ()

9496put _ = pack . Trans.put

src/Control/Monad/Trans/Ether/State/Strict.hs+12−10

@@ -6,6 +6,7 @@

66{-# LANGUAGE DataKinds #-}

77{-# LANGUAGE PolyKinds #-}

88{-# LANGUAGE GeneralizedNewtypeDeriving #-}

9+{-# LANGUAGE MagicHash #-}

910

1011-- | See "Control.Monad.Trans.State.Strict".

1112

@@ -28,6 +29,7 @@ module Control.Monad.Trans.Ether.State.Strict

2829 , put

2930 ) where

3031

32+import GHC.Prim (Proxy#)

3133import Data.Functor.Identity (Identity(..))

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

3335import Control.Monad.Trans.Ether.Tagged

@@ -47,48 +49,48 @@ type State tag r = StateT tag r Identity

4749type StateT tag s = TaggedTrans tag (Trans.StateT s)

4850

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

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

52+stateT :: Proxy# tag -> (s -> m (a, s)) -> StateT tag s m a

5153stateT _ = pack . Trans.StateT

5254

5355-- | Constructor for computations in the state monad

5456-- (the inverse of 'runState').

55−state :: Monad m => proxy tag -> (s -> (a, s)) -> StateT tag s m a

57+state :: Monad m => Proxy# tag -> (s -> (a, s)) -> StateT tag s m a

5658state _ = pack . Trans.state

5759

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

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

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

62+runStateT :: Proxy# tag -> StateT tag s m a -> s -> m (a, s)

6163runStateT _ = Trans.runStateT . unpack

6264

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

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

65−evalStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m a

67+evalStateT :: Monad m => Proxy# tag -> StateT tag s m a -> s -> m a

6668evalStateT _ = Trans.evalStateT . unpack

6769

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

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

70−execStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m s

72+execStateT :: Monad m => Proxy# tag -> StateT tag s m a -> s -> m s

7173execStateT _ = Trans.execStateT . unpack

7274

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

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

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

77+runState :: Proxy# tag -> State tag s a -> s -> (a, s)

7678runState _ = Trans.runState . unpack

7779

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

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

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

82+evalState :: Proxy# tag -> State tag s a -> s -> a

8183evalState _ = Trans.evalState . unpack

8284

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

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

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

87+execState :: Proxy# tag -> State tag s a -> s -> s

8688execState _ = Trans.execState . unpack

8789

8890-- | Fetch the current value of the state within the monad.

89−get :: Monad m => proxy tag -> StateT tag s m s

91+get :: Monad m => Proxy# tag -> StateT tag s m s

9092get _ = pack Trans.get

9193

9294-- | Set the value of the state within the monad.

93−put :: Monad m => proxy tag -> s -> StateT tag s m ()

95+put :: Monad m => Proxy# tag -> s -> StateT tag s m ()

9496put _ = pack . Trans.put

src/Control/Monad/Trans/Ether/Writer.hs+11−9

@@ -7,6 +7,7 @@

77{-# LANGUAGE DataKinds #-}

88{-# LANGUAGE PolyKinds #-}

99{-# LANGUAGE GeneralizedNewtypeDeriving #-}

10+{-# LANGUAGE MagicHash #-}

1011

1112-- | See "Control.Monad.Trans.Writer".

1213

@@ -32,6 +33,7 @@ module Control.Monad.Trans.Ether.Writer

3233import Data.Monoid

3334#endif

3435

36+import GHC.Prim (Proxy#)

3537import Data.Functor.Identity (Identity(..))

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

3739import Control.Monad.Trans.Ether.Tagged

@@ -51,36 +53,36 @@ type Writer tag w = WriterT tag w Identity

5153type WriterT tag w = TaggedTrans tag (Trans.WriterT w)

5254

5355-- | Constructor for computations in the writer monad transformer.

54−writerT :: proxy tag -> m (a, w) -> WriterT tag w m a

56+writerT :: Proxy# tag -> m (a, w) -> WriterT tag w m a

5557writerT _ = pack . Trans.WriterT

5658

5759-- | Constructor for computations in the writer monad

5860-- (the inverse of 'runWriter').

59−writer :: Monad m => proxy tag -> (a, w) -> WriterT tag w m a

61+writer :: Monad m => Proxy# tag -> (a, w) -> WriterT tag w m a

6062writer _ = pack . Trans.writer

6163

6264-- | Runs a 'WriterT' and returns both the normal value

6365-- and the final accumulator.

64−runWriterT :: proxy tag -> WriterT tag w m a -> m (a, w)

66+runWriterT :: Proxy# tag -> WriterT tag w m a -> m (a, w)

6567runWriterT _ = Trans.runWriterT . unpack

6668

6769-- | Runs a 'Writer' and returns both the normal value

6870-- and the final accumulator.

69−runWriter :: proxy tag -> Writer tag w a -> (a, w)

71+runWriter :: Proxy# tag -> Writer tag w a -> (a, w)

7072runWriter _ = Trans.runWriter . unpack

7173

7274-- | Runs a 'WriterT' and returns the final accumulator,

7375-- discarding the normal value.

74−execWriterT :: Monad m => proxy tag -> WriterT tag w m a -> m w

76+execWriterT :: Monad m => Proxy# tag -> WriterT tag w m a -> m w

7577execWriterT _ = Trans.execWriterT . unpack

7678

7779-- | Runs a 'Writer' and returns the final accumulator,

7880-- discarding the normal value.

79−execWriter :: proxy tag -> Writer tag w a -> w

81+execWriter :: Proxy# tag -> Writer tag w a -> w

8082execWriter _ = Trans.execWriter . unpack

8183

8284-- | Appends a value to the accumulator within the monad.

83−tell :: Monad m => proxy tag -> w -> WriterT tag w m ()

85+tell :: Monad m => Proxy# tag -> w -> WriterT tag w m ()

8486tell t w = writer t ((), w)

8587

8688-- | Executes an action and adds its accumulator to the value of the computation.

@@ -90,7 +92,7 @@ listen

9092#else

9193 :: Monad m

9294#endif

93− => proxy tag -> WriterT tag w m a -> WriterT tag w m (a, w)

95+ => Proxy# tag -> WriterT tag w m a -> WriterT tag w m (a, w)

9496listen _ = pack . Trans.listen . unpack

9597

9698-- | Executes an action which returns a value and a function, and returns the

@@ -101,5 +103,5 @@ pass

101103#else

102104 :: Monad m

103105#endif

104− => proxy tag -> WriterT tag w m (a, w -> w) -> WriterT tag w m a

106+ => Proxy# tag -> WriterT tag w m (a, w -> w) -> WriterT tag w m a

105107pass _ = pack . Trans.pass . unpack

test/Regression/T1.hs+9−9

@@ -6,24 +6,24 @@ import Control.Ether.Abbr

66import Test.Tasty

77import Test.Tasty.QuickCheck

9−ethereal "Tag1" "tag1"

10−ethereal "Tag2" "tag2"

9+data Tag1

10+data Tag2

1111

1212testEther

1313 :: Ether '[Tag1 --> String, Tag2 --> String] m

1414 => m ((String, String), (String, String))

1515testEther = do

16− s1 <- ask tag1

17− s2 <- ask tag2

16+ s1 <- ask [tag|Tag1|]

17+ s2 <- ask [tag|Tag2|]

1818 let s1s2 = (s1, s2)

19− s1s2' <- local tag2 (map succ) $ do

20− s1' <- ask tag1

21− s2' <- ask tag2

19+ s1s2' <- local [tag|Tag2|] (map succ) $ do

20+ s1' <- ask [tag|Tag1|]

21+ s2' <- ask [tag|Tag2|]

2222 return (s1', s2')

2323 return (s1s2, s1s2')

2424

25−runner1 s1 s2 = flip (runReader tag1) s1 . flip (runReaderT tag2) s2

26−runner2 s1 s2 = flip (runReader tag2) s2 . flip (runReaderT tag1) s1

25+runner1 s1 s2 = flip (runReader [tag|Tag1|]) s1 . flip (runReaderT [tag|Tag2|]) s2

26+runner2 s1 s2 = flip (runReader [tag|Tag2|]) s2 . flip (runReaderT [tag|Tag1|]) s1

2727

2828test1 :: TestTree

2929test1 = testGroup "T1: Reader local environment"

test/Regression/T3.hs+13−13

@@ -9,8 +9,8 @@ import qualified Control.Monad.State as T

99import Test.Tasty

1010import Test.Tasty.QuickCheck

1111

12−ethereal "RTag" "rTag"

13−ethereal "STag" "sTag"

12+data RTag

13+data STag

1414

1515testMTL :: (T.MonadReader Int m, T.MonadState Int m) => m Int

1616testMTL = do

@@ -22,21 +22,21 @@ testMTL = do

2222testEther

2323 :: Ether '[STag --> Int, STag <-> Int, RTag --> Int] m

2424 => m (Int, Int, Int)

25−testEther = local rTag (*2) $ do

26− a_mul_b <- tagAttach sTag testMTL

27− a_add_b <- get sTag

28− modify sTag negate

29− c <- ask rTag

25+testEther = local [tag|RTag|] (*2) $ do

26+ a_mul_b <- tagAttach [tag|STag|] testMTL

27+ a_add_b <- get [tag|STag|]

28+ modify [tag|STag|] negate

29+ c <- ask [tag|RTag|]

3030 return (a_mul_b, a_add_b, c)

3131

3232runner1 s r

33− = flip (runReader rTag) (negate r)

34− . flip (runReaderT sTag) r

35− . flip (runStateT sTag) s

33+ = flip (runReader [tag|RTag|]) (negate r)

34+ . flip (runReaderT [tag|STag|]) r

35+ . flip (runStateT [tag|STag|]) s

3636runner2 s r

37− = flip (runReader rTag) (negate r)

38− . flip (runStateT sTag) s

39− . flip (runReaderT sTag) r

37+ = flip (runReader [tag|RTag|]) (negate r)

38+ . flip (runStateT [tag|STag|]) s

39+ . flip (runReaderT [tag|STag|]) r

4040

4141test3 :: TestTree

4242test3 = testGroup "T3: Tag attachement"

test/Regression/T4.hs+4−4

@@ -6,14 +6,14 @@ import Control.Monad.Ether

66import Test.Tasty

77import Test.Tasty.QuickCheck

9−ethereal "RTag" "rTag"

9+data RTag

1010

1111testEther :: Ether '[RTag --> Int] m => m Int

12−testEther = ask rTag

12+testEther = ask [tag|RTag|]

1313

1414runner r

15− = flip (runReader rTag) (r' :: Int)

16− . flip (runReaderT rTag) (r :: Int)

15+ = flip (runReader [tag|RTag|]) (r' :: Int)

16+ . flip (runReaderT [tag|RTag|]) (r :: Int)

1717 where

1818 r' = negate r

1919

test/Regression/T7.hs+4−4

@@ -9,7 +9,7 @@ import qualified Control.Monad.Writer as T

99import Test.Tasty

1010import Test.Tasty.QuickCheck

1111

12−ethereal "WTag" "wTag"

12+data WTag

1313

1414testEther

1515 :: Num a

@@ -19,16 +19,16 @@ testEther

1919testEther xs = do

2020 forM_ xs $ \x -> do

2121 T.tell (Sum x)

22− tell wTag (Sum 1)

22+ tell [tag|WTag|] (Sum 1)

2323

2424runner1 :: Num a => [a] -> (a, a)

2525runner1 xs =

26− let (s, c) = T.runWriter . execWriterT wTag $ testEther xs

26+ let (s, c) = T.runWriter . execWriterT [tag|WTag|] $ testEther xs

2727 in (getSum s, getSum c)

2828

2929runner2 :: Num a => [a] -> (a, a)

3030runner2 xs =

31− let (c, s) = runWriter wTag . T.execWriterT $ testEther xs

31+ let (c, s) = runWriter [tag|WTag|] . T.execWriterT $ testEther xs

3232 in (getSum s, getSum c)

3333

3434triangular :: Integral a => a -> a

test/Regression/T8.hs+10−10

@@ -8,8 +8,8 @@ import qualified Control.Monad.State as T

88import Test.Tasty

99import Test.Tasty.QuickCheck

1010

11−ethereal "Foo" "foo"

12−ethereal "Bar" "bar"

11+data Foo

12+data Bar

1313

1414testMTL1 :: T.MonadState Int m => m ()

1515testMTL1 = T.modify negate

@@ -21,22 +21,22 @@ testEther

2121 :: Ether '[Foo <-> Int, Bar <-> Bool] m

2222 => m String

2323testEther = do

24− tagAttach foo testMTL1

25− tagAttach bar testMTL2

26− a <- gets foo show

27− b <- gets bar show

24+ tagAttach [tag|Foo|] testMTL1

25+ tagAttach [tag|Bar|] testMTL2

26+ a <- gets [tag|Foo|] show

27+ b <- gets [tag|Bar|] show

2828 return (a ++ b)

2929

3030model :: Int -> Bool -> String

3131model a b = show (negate a) ++ show (not b)

3232

3333runner1 a b

34− = flip (evalState foo) a

35− . flip (evalStateT bar) b

34+ = flip (evalState [tag|Foo|]) a

35+ . flip (evalStateT [tag|Bar|]) b

3636

3737runner2 a b

38− = flip (evalState bar) b

39− . flip (evalStateT foo) a

38+ = flip (evalState [tag|Bar|]) b

39+ . flip (evalStateT [tag|Foo|]) a

4040

4141test8 :: TestTree

4242test8 = testGroup "T8: Multiple tag attachements"

test/Regression/T9.hs+9−10

@@ -6,17 +6,16 @@ import Control.Monad.Ether

66import Test.Tasty

77import Test.Tasty.QuickCheck

9−ethereal "Foo" "foo"

10−ethereal "Bar" "bar"

11−

9+data Foo

10+data Bar

1211

1312testEther1 :: Ether '[Foo <-> Int] m => m String

1413testEther1 = do

15− modify foo negate

16− gets foo show

14+ modify [tag|Foo|] negate

15+ gets [tag|Foo|] show

1716

1817testEther2 :: Ether '[Bar <-> Int] m => m String

19−testEther2 = tagReplace foo bar testEther1

18+testEther2 = tagReplace [tag|Foo|] [tag|Bar|] testEther1

2019

2120testEther

2221 :: Ether '[Foo <-> Int, Bar <-> Int] m

@@ -30,12 +29,12 @@ model :: Int -> Int -> String

3029model a b = show (negate a) ++ show (negate b)

3130

3231runner1 a b

33− = flip (evalState foo) a

34− . flip (evalStateT bar) b

32+ = flip (evalState [tag|Foo|]) a

33+ . flip (evalStateT [tag|Bar|]) b

3534

3635runner2 a b

37− = flip (evalState bar) b

38− . flip (evalStateT foo) a

36+ = flip (evalState [tag|Bar|]) b

37+ . flip (evalStateT [tag|Foo|]) a

3938

4039test9 :: TestTree

4140test9 = testGroup "T9: Tag replacement"