d130b1d · typeable/ether

ether.cabal+2

compare with master

unifiedsplit

@@ -103,6 +103,8 @@ test-suite regression

103 Regression.T4

104 Regression.T5

105 Regression.T6

106+ Regression.T7

107+ Regression.T8

106

108

107 type: exitcode-stdio-1.0

109 type: exitcode-stdio-1.0

108 hs-source-dirs: test

110 hs-source-dirs: test

test/Regression.hs+4−29

@@ -6,9 +6,6 @@ import Control.Monad

6import Control.Monad.Ether

7import Control.Ether.Abbr

8

9−import qualified Control.Monad.Ether.Implicit as I

10−import qualified Control.Ether.Implicit.Abbr as I

11−

12import qualified Control.Monad.Reader as T

9import qualified Control.Monad.Reader as T

13import qualified Control.Monad.Writer as T

10import qualified Control.Monad.Writer as T

14import qualified Control.Monad.State as T

11import qualified Control.Monad.State as T

@@ -21,9 +18,9 @@ import Regression.T3

21import Regression.T4

18import Regression.T4

22import Regression.T5

19import Regression.T5

23import Regression.T6

20import Regression.T6

21+import Regression.T7

22+import Regression.T8

24

23

25−ethereal "R1" "r1"

26−ethereal "S1" "s1"

27ethereal "Foo" "foo"

24ethereal "Foo" "foo"

28ethereal "Bar" "bar"

25ethereal "Bar" "bar"

29

26

@@ -38,32 +35,10 @@ suite = testGroup "Ether"

38 , test4

35 , test4

39 , test5

36 , test5

40 , test6

37 , test6

38+ , test7

39+ , test8

41 ]

40 ]

42

41

43−data DivideByZero = DivideByZero

44− deriving (Show)

45−data NegativeLog a = NegativeLog a

46− deriving (Show)

47−

48−exceptCore

49− :: ( Floating a, Ord a

50− , Ether '[I.E DivideByZero, I.E (NegativeLog a)] m

51− ) => a -> a -> m a

52−exceptCore a b = do

53− T.when (b == 0) (I.throw DivideByZero)

54− let d = a /b

55− T.when (d < 0) (I.throw (NegativeLog d))

56− return (log d)

57−

58−(&) :: a -> (a -> c) -> c

59−(&) = flip ($)

60−

61−exceptCore' :: Double -> Double -> String

62−exceptCore' a b = do

63− liftM show (exceptCore a b)

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

65− &I.handle (\DivideByZero -> "dz")

66−

67summatorCore

42summatorCore

68 :: ( Num a

43 :: ( Num a

69 , T.MonadWriter (Sum a) m

44 , T.MonadWriter (Sum a) m

test/Regression/T5.hs+2−1

@@ -15,7 +15,8 @@ incCounter :: Counter -> Counter

15incCounter = succ

16

17testEther

18+ :: (Num a, Ord a)

18− :: (Num a, Ord a) => Ether '[I.R a, I.S Counter] m

19+ => Ether '[I.R a, I.S Counter] m

19 => m a

20 => m a

20testEther = do

21testEther = do

21 a <- I.ask

22 a <- I.ask

test/Regression/T6.hs+61−1

@@ -1,6 +1,66 @@

1module Regression.T6 (test6) where

2

3+import Control.Monad

4+import Control.Ether.Abbr

5+

6+import qualified Control.Monad.Ether.Implicit as I

7+import qualified Control.Ether.Implicit.Abbr as I

8+

3import Test.Tasty

9import Test.Tasty

10+import Test.Tasty.QuickCheck

11+

12+data DivideByZero = DivideByZero

13+ deriving (Show)

14+

15+data NegativeLog a = NegativeLog a

16+ deriving (Show)

17+

18+testEther

19+ :: (Floating a, Ord a)

20+ => Ether '[I.E DivideByZero, I.E (NegativeLog a)] m

21+ => a -> a -> m a

22+testEther a b = do

23+ when (b == 0) (I.throw DivideByZero)

24+ let d = a / b

25+ when (d < 0) (I.throw (NegativeLog d))

26+ return (log d)

27+

28+-- Copied verbatim from "Data.Function" to support @base < 4.8@.

29+(&) :: a -> (a -> b) -> b

30+x & f = f x

31+

32+handleNegativeLog (NegativeLog (x :: Double)) = "nl: " ++ show x

33+handleDivideByZero DivideByZero = "dz"

34+

35+runner1 :: Double -> Double -> String

36+runner1 a b = do

37+ (show <$> testEther a b)

38+ & I.handleT handleNegativeLog

39+ & I.handle handleDivideByZero

40+

41+runner2 :: Double -> Double -> String

42+runner2 a b = do

43+ (show <$> testEther a b)

44+ & I.handleT handleDivideByZero

45+ & I.handle handleNegativeLog

46+

47+logDiv :: Double -> Double -> String

48+logDiv a b

49+ | b == 0 = "dz"

50+ | d < 0 = "nl: " ++ show d

51+ | otherwise = show (log d)

52+ where

53+ d = a / b

4

54

5test6 :: TestTree

55test6 :: TestTree

6−test6 = testGroup "T6:" []

56+test6 = testGroup "T6: Checked exceptions"

57+ [ testProperty "runner₁ works"

58+ $ \a b -> property

59+ $ runner1 a b == logDiv a b

60+ , testProperty "runner₂ works"

61+ $ \a b -> property

62+ $ runner2 a b == logDiv a b

63+ , testProperty "runner₁ == runner₂"

64+ $ \a b -> property

65+ $ runner1 a b == runner2 a b

66+ ]

test/Regression/T7.hsnew file+6

@@ -0,0 +1,6 @@

1+module Regression.T7 (test7) where

2+

3+import Test.Tasty

4+

5+test7 :: TestTree

6+test7 = testGroup "T7:" []

test/Regression/T8.hsnew file+6

@@ -0,0 +1,6 @@

1+module Regression.T8 (test8) where

2+

3+import Test.Tasty

4+

5+test8 :: TestTree

6+test8 = testGroup "T8:" []