3e0c17e · typeable/ether

ether.cabal+1

compare with master

unifiedsplit

@@ -35,6 +35,7 @@ library

35 Control.Monad.Ether.Implicit.Reader

36 Control.Monad.Ether.Implicit.State

37 Control.Monad.Ether.Implicit.Except

38+ Control.Monad.Ether.Implicit.Except.TH

38

39

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

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

40 , transformers >=0.4.0.3

41 , transformers >=0.4.0.3

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

@@ -1,5 +1,9 @@

1{-# LANGUAGE TemplateHaskell #-}

2−module Control.Ether.TH (ethereal) where

2+module Control.Ether.TH

3+ ( ethereal

4+ , fmapN

5+ , deepN

6+ ) where

3

7

4import qualified Language.Haskell.TH as TH

8import qualified Language.Haskell.TH as TH

5

9

@@ -33,3 +37,11 @@ ethereal strTagName strTagProxyName = do

33 tagDecl <- emptyDataDecl tagName

37 tagDecl <- emptyDataDecl tagName

34 (tagProxySig, tagProxyVal) <- proxySimple tagProxyName tag

38 (tagProxySig, tagProxyVal) <- proxySimple tagProxyName tag

35 return [tagDecl, tagProxySig, tagProxyVal]

39 return [tagDecl, tagProxySig, tagProxyVal]

40+

41+fmapN :: Int -> TH.ExpQ

42+fmapN 0 = [|id|]

43+fmapN n = TH.infixApp [|fmap|] [|(.)|] (fmapN (n - 1))

44+

45+deepN :: Int -> TH.ExpQ -> TH.ExpQ

46+deepN 0 _ = [|id|]

47+deepN n f = [| $(fmapN n) $f $(deepN (n-1) f) |]

src/Control/Monad/Ether/Implicit/Except/TH.hsnew file+12

@@ -0,0 +1,12 @@

1+{-# LANGUAGE TemplateHaskell #-}

2+module Control.Monad.Ether.Implicit.Except.TH (try', try) where

3+

4+import qualified Language.Haskell.TH as TH

5+import Control.Ether.TH (deepN)

6+import Control.Monad.Ether.Implicit.Except

7+

8+try' :: Functor m => ExceptT e m a -> (e -> a) -> m a

9+try' m h = either h id <$> runExceptT m

10+

11+try :: Int -> TH.ExpQ

12+try n = deepN n [|try'|]

test/Regression.hs+19−4

@@ -7,11 +7,13 @@

7{-# LANGUAGE LambdaCase #-}

8module Main where

9

10+import Data.Functor.Identity

10import Control.Ether.Tags

11import Control.Ether.Tags

11import Control.Ether.TH

12import Control.Ether.TH

12import Control.Ether.Wrapped

13import Control.Ether.Wrapped

13import Control.Monad.Ether.Reader

14import Control.Monad.Ether.Reader

14import Control.Monad.Ether.State

15import Control.Monad.Ether.State

16+import Control.Monad.Ether.Implicit.Except.TH

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

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

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

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

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

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

@@ -162,8 +164,21 @@ exceptCore a b = do

162 then I.throw NegativeLog

164 then I.throw NegativeLog

163 else return $ log (a / b)

165 else return $ log (a / b)

164

166

167+try0 :: m a -> m a

168+try0 = $(try 0)

169+

170+try1 :: Functor m => I.ExceptT e m a -> (e -> a) -> m a

171+try1 = $(try 1)

172+

173+try2 :: Functor m => I.ExceptT e1 (I.ExceptT e2 m) a -> (e1 -> a) -> (e2 -> a) -> m a

174+try2 = $(try 2)

175+

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

177+try3 = $(try 3)

178+

165exceptCore' :: Double -> Double -> String

179exceptCore' :: Double -> Double -> String

166−exceptCore' a b

180+exceptCore' a b = runIdentity $ do

181+ $(try 2)

182+ (show <$> exceptCore a b)

167− = either (\NegativeLog -> "nl") id

183+ (\NegativeLog -> "nl")

168− $ I.runExcept

169− (either (\DivideByZero -> "dz") show <$> I.runExceptT (exceptCore a b))

184+ (\DivideByZero -> "dz")