2c7b5d3 · typeable/ether

CHANGELOG.md+4−1

compare with master

unifiedsplit

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

1−0.1.1.0

1+0.2.0.0

2-------

3

4* 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`.

5

8

6

9

70.1.0.1

100.1.0.1

ether.cabal−1

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

51 Control.Monad.Ether.Implicit.State.Lazy

52 Control.Monad.Ether.Implicit.State.Strict

53 Control.Monad.Ether.Implicit.Except

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

55

54

56 other-modules: Control.Ether.Util

55 other-modules: Control.Ether.Util

57

56

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

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

1{-# LANGUAGE TemplateHaskell #-}

2

3−-- | Template haskell utilities.

3+-- | Template Haskell utilities.

4

5module Control.Ether.TH

6 ( ethereal

7− , fmapN

8− , deepN

9 ) where

7 ) where

10

8

11import qualified Language.Haskell.TH as TH

9import qualified Language.Haskell.TH as TH

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

40 tagDecl <- emptyDataDecl tagName

38 tagDecl <- emptyDataDecl tagName

41 (tagProxySig, tagProxyVal) <- proxySimple tagProxyName tag

39 (tagProxySig, tagProxyVal) <- proxySimple tagProxyName tag

42 return [tagDecl, tagProxySig, tagProxyVal]

40 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

13 , exceptT

14 , runExceptT

15 , mapExceptT

16+ -- * Handle functions

17+ , handleT

18+ , handle

16 ) where

19 ) where

17

20

18import Control.Monad.Ether.Except.Class

21import Control.Monad.Ether.Except.Class

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

22import 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

17 , exceptT

18 , runExceptT

19 , mapExceptT

20+ -- * Handle functions

21+ , handle

22+ , handleT

20 ) where

23 ) where

21

24

22import Data.Proxy

25import Data.Proxy

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

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

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

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

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

57mapExceptT = Explicit.mapExceptT Proxy

60mapExceptT = 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 @@

7{-# LANGUAGE LambdaCase #-}

8module Main where

9

10−import Data.Functor.Identity

11import Data.Monoid

10import Data.Monoid

12import Control.Monad

11import Control.Monad

13import Control.Ether.Tagged

12import Control.Ether.Tagged

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

16import Control.Monad.Ether.Reader

15import Control.Monad.Ether.Reader

17import Control.Monad.Ether.State

16import Control.Monad.Ether.State

18import Control.Monad.Ether.Writer

17import Control.Monad.Ether.Writer

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

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

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

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

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

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

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

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

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

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

168 return (log d)

166 return (log d)

169

167

170−try0 :: m a -> m a

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

171−try0 = $(try 0)

169+(&) = flip ($)

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)

181

170

182exceptCore' :: Double -> Double -> String

171exceptCore' :: Double -> Double -> String

183−exceptCore' a b = runIdentity $ do

172+exceptCore' a b = do

184− $(try 2)

185− (liftM show (exceptCore a b))

173+ liftM show (exceptCore a b)

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

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

187− (\DivideByZero -> "dz")

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

188

176

189summatorCore

177summatorCore

190 :: ( Num a

178 :: ( Num a