da8edd9 · typeable/ether

git.iko.soy/typeable/ether

Proxy-hash for MonadExcept

commitda8edd9bd343da43108e67bf066a6be3e1da0a57 authorIndex Int <vlad.z.4096@gmail.com> dateSat 30 Apr 2016, 13:23 (10 years ago) parent3977c8b

7 files changed+37−26

compare with master

unifiedsplit

ether.cabal+2 src/Control/Ether/TH.hs+4−3 src/Control/Monad/Ether/Except.hs+4−2 src/Control/Monad/Ether/Except/Class.hs+4−3 src/Control/Monad/Ether/Implicit/Except.hs+9−8 src/Control/Monad/Trans/Ether/Dispatch.hs+6−4 src/Control/Monad/Trans/Ether/Except.hs+8−6

ether.cabal+2

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

src/Control/Ether/TH.hs+4−3

@@ -1,4 +1,5 @@

11{-# LANGUAGE TemplateHaskell #-}

2+{-# LANGUAGE MagicHash #-}

23{-# LANGUAGE CPP #-}

45-- | Template Haskell utilities.

@@ -9,7 +10,7 @@ module Control.Ether.TH

910

1011import qualified Language.Haskell.TH as TH

1112

12−import Data.Proxy

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

1314

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

1516#if __GLASGOW_HASKELL__ < 800

@@ -23,8 +24,8 @@ funSimple name body = TH.funD name [ TH.clause [] (TH.normalB body) [] ]

2324

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

2526proxySimple name ty = do

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

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

27+ sig <- TH.sigD name [t| Proxy# $ty |]

28+ val <- funSimple name [e| proxy# |]

2829 return (sig, val)

2930

3031-- |

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#, 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/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/Trans/Ether/Dispatch.hs+6−4

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

1313{-# LANGUAGE DataKinds #-}

1414{-# LANGUAGE PolyKinds #-}

1515{-# LANGUAGE GeneralizedNewtypeDeriving #-}

16+{-# LANGUAGE MagicHash #-}

1617

1718{- |

1819

@@ -67,6 +68,7 @@ import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)

6768import GHC.Generics (Generic)

6869import Data.Coerce (coerce)

6970import Data.Proxy

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

7072

7173import qualified Control.Monad.Base as MB

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

@@ -173,8 +175,8 @@ instance MonadState tag s m

173175

174176instance MonadExcept tag e m

175177 => 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)

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

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

178180

179181instance MonadWriter tag w m

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

@@ -198,8 +200,8 @@ instance MonadState tNew s m

198200

199201instance MonadExcept tNew e m

200202 => 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)

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

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

203205

204206instance MonadWriter tNew w m

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

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)