c562d14 · typeable/ether

ether.cabal+1

compare with master

unifiedsplit

@@ -34,6 +34,7 @@ library

34 Control.Monad.Ether.Except

35 Control.Monad.Ether.Implicit.Reader

36 Control.Monad.Ether.Implicit.State

37+ Control.Monad.Ether.Implicit.Except

37

38

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

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

39 , transformers >=0.4.0.3

40 , 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 @@

4{-# LANGUAGE TemplateHaskell #-}

5{-# LANGUAGE ConstraintKinds #-}

6{-# LANGUAGE ScopedTypeVariables #-}

7+{-# LANGUAGE LambdaCase #-}

7module Main where

8module Main where

8

9

9import Control.Ether.Tags

10import Control.Ether.Tags

@@ -13,6 +14,7 @@ import Control.Monad.Ether.Reader

13import Control.Monad.Ether.State

14import Control.Monad.Ether.State

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

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

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

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

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

16import qualified Control.Monad.Reader as T

18import qualified Control.Monad.Reader as T

17import qualified Control.Monad.State as T

19import qualified Control.Monad.State as T

18

20

@@ -140,3 +142,28 @@ factorial a = I.runState (I.runReaderT recurseCore a) (0 :: Int)

140

142

141factorial' :: Int -> (Int, Int)

143factorial' :: Int -> (Int, Int)

142factorial' a = factorial (a :: Int)

144factorial' 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))