git.iko.soy/typeable/ether
on master help sign in
try-construct with TH
commit3e0c17e9493f59bdb6d2f1b6741a13e55c0fc1f3 authorIndex Int <vlad.z.4096@gmail.com> dateFri 12 Jun 2015, 15:48 (11 years ago) parentc562d14
4 files changed+45−5
compare with master
unifiedsplit
ether.cabal+1 src/Control/Ether/TH.hs+13−1 src/Control/Monad/Ether/Implicit/Except/TH.hs+12 test/Regression.hs+19−4
ether.cabal+1
@@ -35,6 +35,7 @@ library
3535 Control.Monad.Ether.Implicit.Reader
3636 Control.Monad.Ether.Implicit.State
3737 Control.Monad.Ether.Implicit.Except
38+ Control.Monad.Ether.Implicit.Except.TH
3839
3940 build-depends: base >=4.8 && <4.9
4041 , transformers >=0.4.0.3
src/Control/Ether/TH.hs+13−1
@@ -1,5 +1,9 @@
11{-# LANGUAGE TemplateHaskell #-}
2−module Control.Ether.TH (ethereal) where
2+module Control.Ether.TH
3+ ( ethereal
4+ , fmapN
5+ , deepN
6+ ) where
37
48import qualified Language.Haskell.TH as TH
59
@@ -33,3 +37,11 @@ ethereal strTagName strTagProxyName = do
3337 tagDecl <- emptyDataDecl tagName
3438 (tagProxySig, tagProxyVal) <- proxySimple tagProxyName tag
3539 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 @@
77{-# LANGUAGE LambdaCase #-}
88module Main where
99
10+import Data.Functor.Identity
1011import Control.Ether.Tags
1112import Control.Ether.TH
1213import Control.Ether.Wrapped
1314import Control.Monad.Ether.Reader
1415import Control.Monad.Ether.State
16+import Control.Monad.Ether.Implicit.Except.TH
1517import qualified Control.Monad.Ether.Implicit.Reader as I
1618import qualified Control.Monad.Ether.Implicit.State as I
1719import qualified Control.Monad.Ether.Implicit.Except as I
@@ -162,8 +164,21 @@ exceptCore a b = do
162164 then I.throw NegativeLog
163165 else return $ log (a / b)
164166
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+
165179exceptCore' :: Double -> Double -> String
166−exceptCore' a b
167− = either (\NegativeLog -> "nl") id
168− $ I.runExcept
169− (either (\DivideByZero -> "dz") show <$> I.runExceptT (exceptCore a b))
180+exceptCore' a b = runIdentity $ do
181+ $(try 2)
182+ (show <$> exceptCore a b)
183+ (\NegativeLog -> "nl")
184+ (\DivideByZero -> "dz")