git.iko.soy/typeable/ether
on master help sign in
Implicit MonadExcept
commitc562d142999598d0920bcf42080d2c8eb76dc0ca authorIndex Int <vlad.z.4096@gmail.com> dateFri 12 Jun 2015, 02:54 (11 years ago) parent0f9f8fc
3 files changed+68
compare with master
unifiedsplit
ether.cabal+1 src/Control/Monad/Ether/Implicit/Except.hs+40 test/Regression.hs+27
ether.cabal+1
@@ -34,6 +34,7 @@ library
3434 Control.Monad.Ether.Except
3535 Control.Monad.Ether.Implicit.Reader
3636 Control.Monad.Ether.Implicit.State
37+ Control.Monad.Ether.Implicit.Except
3738
3839 build-depends: base >=4.8 && <4.9
3940 , transformers >=0.4.0.3
src/Control/Monad/Ether/Implicit/Except.hsnew file+40
@@ -0,0 +1,40 @@
1+{-# LANGUAGE ConstraintKinds #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
3+module Control.Monad.Ether.Implicit.Except
4+ (
5+ -- * MonadExcept class
6+ MonadExcept
7+ , throw
8+ , catch
9+ -- * The Except monad
10+ , Except
11+ , runExcept
12+ -- * The ExceptT monad transformer
13+ , ExceptT
14+ , exceptT
15+ , runExceptT
16+ ) where
17+
18+import Data.Proxy
19+import qualified Control.Monad.Ether.Except as Explicit
20+
21+type MonadExcept e = Explicit.MonadExcept e e
22+
23+throw :: forall e m a . MonadExcept e m => e -> m a
24+throw = Explicit.throw (Proxy :: Proxy e)
25+
26+catch :: forall e m a . MonadExcept e m => m a -> (e -> m a) -> m a
27+catch = Explicit.catch (Proxy :: Proxy e)
28+
29+type Except e = Explicit.Except e e
30+
31+runExcept :: Except e a -> Either e a
32+runExcept = Explicit.runExcept Proxy
33+
34+type ExceptT e = Explicit.ExceptT e e
35+
36+exceptT :: m (Either e a) -> ExceptT e m a
37+exceptT = Explicit.exceptT Proxy
38+
39+runExceptT :: ExceptT e m a -> m (Either e a)
40+runExceptT = Explicit.runExceptT Proxy
test/Regression.hs+27
@@ -4,6 +4,7 @@
44{-# LANGUAGE TemplateHaskell #-}
55{-# LANGUAGE ConstraintKinds #-}
66{-# LANGUAGE ScopedTypeVariables #-}
7+{-# LANGUAGE LambdaCase #-}
78module Main where
89
910import Control.Ether.Tags
@@ -13,6 +14,7 @@ import Control.Monad.Ether.Reader
1314import Control.Monad.Ether.State
1415import qualified Control.Monad.Ether.Implicit.Reader as I
1516import qualified Control.Monad.Ether.Implicit.State as I
17+import qualified Control.Monad.Ether.Implicit.Except as I
1618import qualified Control.Monad.Reader as T
1719import qualified Control.Monad.State as T
1820
@@ -140,3 +142,28 @@ factorial a = I.runState (I.runReaderT recurseCore a) (0 :: Int)
140142
141143factorial' :: Int -> (Int, Int)
142144factorial' a = factorial (a :: Int)
145+
146+data DivideByZero = DivideByZero
147+ deriving (Show)
148+data NegativeLog = NegativeLog
149+ deriving (Show)
150+
151+exceptCore
152+ :: ( Floating a, Ord a
153+ , I.MonadExcept DivideByZero m
154+ , I.MonadExcept NegativeLog m
155+ ) => a -> a -> m a
156+exceptCore a b = do
157+ if b == 0
158+ then I.throw DivideByZero
159+ else
160+ let d = a /b
161+ in if d < 0
162+ then I.throw NegativeLog
163+ else return $ log (a / b)
164+
165+exceptCore' :: 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))