2c7b5d3 · typeable/ether

git.iko.soy/typeable/ether

Replace TH-based try function with handle

commit2c7b5d359f036d47c86091a4836050274ff721c9 authorIndex Int <vlad.z.4096@gmail.com> dateSun 14 Jun 2015, 23:16 (11 years ago) parent82d35d4

7 files changed+34−61

compare with master

unifiedsplit

CHANGELOG.md+4−1 ether.cabal−1 src/Control/Ether/TH.hs+1−19 src/Control/Monad/Ether/Except.hs+12 src/Control/Monad/Ether/Implicit/Except.hs+11 src/Control/Monad/Ether/Implicit/Except/TH.hs−22 test/Regression.hs+6−18

CHANGELOG.md+4−1

@@ -1,7 +1,10 @@

1−0.1.1.0

1+0.2.0.0

22-------

44* Convenience modules `Control.Monad.Ether` and `Control.Monad.Ether.Implicit`.

5+* Remove `fmapN` and `deepN`.

6+* Remove `Control.Monad.Ether.Implicit.Except.TH`.

7+* Add `handle` and `handleT`.

7100.1.0.1

ether.cabal−1

@@ -51,7 +51,6 @@ library

5151 Control.Monad.Ether.Implicit.State.Lazy

5252 Control.Monad.Ether.Implicit.State.Strict

5353 Control.Monad.Ether.Implicit.Except

54− Control.Monad.Ether.Implicit.Except.TH

5554

5655 other-modules: Control.Ether.Util

5756

src/Control/Ether/TH.hs+1−19

@@ -1,11 +1,9 @@

11{-# LANGUAGE TemplateHaskell #-}

3−-- | Template haskell utilities.

3+-- | Template Haskell utilities.

55module Control.Ether.TH

66 ( ethereal

7− , fmapN

8− , deepN

97 ) where

108

119import qualified Language.Haskell.TH as TH

@@ -40,19 +38,3 @@ ethereal strTagName strTagProxyName = do

4038 tagDecl <- emptyDataDecl tagName

4139 (tagProxySig, tagProxyVal) <- proxySimple tagProxyName tag

4240 return [tagDecl, tagProxySig, tagProxyVal]

43−

44−-- |

45−-- Compose 'fmap' @n@ times.

46−--

47−-- @$('fmapN' 5) = fmap.fmap.fmap.fmap.fmap@

48−fmapN :: Int -> TH.ExpQ

49−fmapN 0 = [|id|]

50−fmapN n = TH.infixApp [|fmap|] [|(.)|] (fmapN (n - 1))

51−

52−-- |

53−-- 'fmap' a function @n@ levels deep.

54−--

55−-- @$('deepN' 3 [| f |]) = $('fmapN' 3) f ($('fmapN' 2) f ($('fmapN' 1) f id))@

56−deepN :: Int -> TH.ExpQ -> TH.ExpQ

57−deepN 0 _ = [|id|]

58−deepN n f = [| $(fmapN n) $f $(deepN (n-1) f) |]

src/Control/Monad/Ether/Except.hs+12

@@ -13,7 +13,19 @@ module Control.Monad.Ether.Except

1313 , exceptT

1414 , runExceptT

1515 , mapExceptT

16+ -- * Handle functions

17+ , handleT

18+ , handle

1619 ) where

1720

1821import Control.Monad.Ether.Except.Class

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

23+import Data.Functor.Identity (Identity(..))

24+

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

26+handle :: proxy tag -> (e -> a) -> Except tag e a -> a

27+handle t h m = runIdentity (handleT t h m)

28+

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

30+handleT :: Functor m => proxy tag -> (e -> a) -> ExceptT tag e m a -> m a

31+handleT t h m = fmap (either h id) (runExceptT t m)

src/Control/Monad/Ether/Implicit/Except.hs+11

@@ -17,6 +17,9 @@ module Control.Monad.Ether.Implicit.Except

1717 , exceptT

1818 , runExceptT

1919 , mapExceptT

20+ -- * Handle functions

21+ , handle

22+ , handleT

2023 ) where

2124

2225import Data.Proxy

@@ -55,3 +58,11 @@ runExceptT = Explicit.runExceptT Proxy

5558-- Note that due to implicit tagging the exception type cannot be changed.

5659mapExceptT :: (m (Either e a) -> n (Either e b)) -> ExceptT e m a -> ExceptT e n b

5760mapExceptT = Explicit.mapExceptT Proxy

61+

62+-- | See 'Control.Monad.Ether.Except.handle'.

63+handle :: (e -> a) -> Except e a -> a

64+handle = Explicit.handle (Proxy :: Proxy e)

65+

66+-- | See 'Control.Monad.Ether.Except.handleT'.

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

68+handleT = Explicit.handleT (Proxy :: Proxy e)

src/Control/Monad/Ether/Implicit/Except/TH.hsdeleted−22

@@ -1,22 +0,0 @@

1−{-# LANGUAGE TemplateHaskell #-}

2−

3−-- | Template Haskell utilities for exception handling.

4−

5−module Control.Monad.Ether.Implicit.Except.TH (try', try) where

6−

7−import qualified Language.Haskell.TH as TH

8−import Control.Ether.TH (deepN)

9−import Control.Monad.Ether.Implicit.Except

10−

11−-- | Basic building block for 'try'. Runs an 'ExceptT' with a handler.

12−try' :: Functor m => ExceptT e m a -> (e -> a) -> m a

13−try' m h = fmap (either h id) (runExceptT m)

14−

15−-- | Handle @n@ exceptions with supplied handlers.

16−--

17−-- > $(try 3) monadicComputation

18−-- > (\Exception1 -> ...)

19−-- > (\Exception2 -> ...)

20−-- > (\Exception3 -> ...)

21−try :: Int -> TH.ExpQ

22−try n = deepN n [|try'|]

test/Regression.hs+6−18

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

77{-# LANGUAGE LambdaCase #-}

88module Main where

10−import Data.Functor.Identity

1110import Data.Monoid

1211import Control.Monad

1312import Control.Ether.Tagged

@@ -16,7 +15,6 @@ import Control.Ether.Wrapped

1615import Control.Monad.Ether.Reader

1716import Control.Monad.Ether.State

1817import Control.Monad.Ether.Writer

19−import Control.Monad.Ether.Implicit.Except.TH

2018import qualified Control.Monad.Ether.Implicit.Reader as I

2119import qualified Control.Monad.Ether.Implicit.State as I

2220import qualified Control.Monad.Ether.Implicit.Except as I

@@ -167,24 +165,14 @@ exceptCore a b = do

167165 T.when (d < 0) (I.throw (NegativeLog d))

168166 return (log d)

169167

170−try0 :: m a -> m a

171−try0 = $(try 0)

172−

173−try1 :: Functor m => I.ExceptT e m a -> (e -> a) -> m a

174−try1 = $(try 1)

175−

176−try2 :: Functor m => I.ExceptT e1 (I.ExceptT e2 m) a -> (e1 -> a) -> (e2 -> a) -> m a

177−try2 = $(try 2)

178−

179−try3 :: Functor m => I.ExceptT e1 (I.ExceptT e2 (I.ExceptT e3 m)) a -> (e1 -> a) -> (e2 -> a) -> (e3 -> a) -> m a

180−try3 = $(try 3)

168+(&) :: a -> (a -> c) -> c

169+(&) = flip ($)

181170

182171exceptCore' :: Double -> Double -> String

183−exceptCore' a b = runIdentity $ do

184− $(try 2)

185− (liftM show (exceptCore a b))

186− (\(NegativeLog (x::Double)) -> "nl: " ++ show x)

187− (\DivideByZero -> "dz")

172+exceptCore' a b = do

173+ liftM show (exceptCore a b)

174+ &I.handleT (\(NegativeLog (x::Double)) -> "nl: " ++ show x)

175+ &I.handle (\DivideByZero -> "dz")

188176

189177summatorCore

190178 :: ( Num a