git.iko.soy/typeable/ether
on master help sign in
Test-suite update (T7)
commitfc0b524377c6dc1b7967f1c5ff12b2649d45788c authorIndex Int <vlad.z.4096@gmail.com> dateSat 23 Jan 2016, 15:18 (11 years ago) parentd130b1d
3 files changed+47−18
compare with master
unifiedsplit
test/Regression.hs−15 test/Regression/T6.hs+2−2 test/Regression/T7.hs+45−1
test/Regression.hs−15
@@ -1,13 +1,11 @@
11module Main where
22
3−import Data.Monoid
43import Control.Monad
54
65import Control.Monad.Ether
76import Control.Ether.Abbr
87
98import qualified Control.Monad.Reader as T
10−import qualified Control.Monad.Writer as T
119import qualified Control.Monad.State as T
1210
1311import Test.Tasty
@@ -39,19 +37,6 @@ suite = testGroup "Ether"
3937 , test8
4038 ]
4139
42−summatorCore
43− :: ( Num a
44− , T.MonadWriter (Sum a) m
45− , MonadWriter Foo (Sum a) m
46− ) => [a] -> m ()
47−summatorCore xs = do
48− forM_ xs $ \x -> do
49− T.tell (Sum x)
50− tell foo (Sum 1)
51−
52−summatorCore' :: Num a => [a] -> (Sum a, Sum a)
53−summatorCore' = runWriter foo . T.execWriterT . summatorCore
54−
5540wrapState_f :: T.MonadState Int m => m String
5641wrapState_f = liftM show T.get
5742
test/Regression/T6.hs+2−2
@@ -34,13 +34,13 @@ handleDivideByZero DivideByZero = "dz"
3434
3535runner1 :: Double -> Double -> String
3636runner1 a b = do
37− (show <$> testEther a b)
37+ (show `fmap` testEther a b)
3838 & I.handleT handleNegativeLog
3939 & I.handle handleDivideByZero
4040
4141runner2 :: Double -> Double -> String
4242runner2 a b = do
43− (show <$> testEther a b)
43+ (show `fmap` testEther a b)
4444 & I.handleT handleDivideByZero
4545 & I.handle handleNegativeLog
4646
test/Regression/T7.hs+45−1
@@ -1,6 +1,50 @@
11module Regression.T7 (test7) where
22
3+import Data.Monoid
4+import Control.Monad
5+
6+import Control.Monad.Ether
7+import qualified Control.Monad.Writer as T
8+
39import Test.Tasty
10+import Test.Tasty.QuickCheck
11+
12+ethereal "WTag" "wTag"
13+
14+testEther
15+ :: Num a
16+ => T.MonadWriter (Sum a) m
17+ => MonadWriter WTag (Sum a) m
18+ => [a] -> m ()
19+testEther xs = do
20+ forM_ xs $ \x -> do
21+ T.tell (Sum x)
22+ tell wTag (Sum 1)
23+
24+runner1 :: Num a => [a] -> (a, a)
25+runner1 xs =
26+ let (s, c) = T.runWriter . execWriterT wTag $ testEther xs
27+ in (getSum s, getSum c)
28+
29+runner2 :: Num a => [a] -> (a, a)
30+runner2 xs =
31+ let (c, s) = runWriter wTag . T.execWriterT $ testEther xs
32+ in (getSum s, getSum c)
33+
34+triangular :: Integral a => a -> a
35+triangular n = div (n * (n + 1)) 2
436
537test7 :: TestTree
6−test7 = testGroup "T7:" []
38+test7 = testGroup "T7: Triangular via Ether"
39+ [ testProperty "runner₁ works"
40+ $ \n -> property
41+ $ let n' = abs n :: Integer
42+ in runner1 [1..n'] == (n', triangular n')
43+ , testProperty "runner₂ works"
44+ $ \n -> property
45+ $ let n' = abs n :: Integer
46+ in runner2 [1..n'] == (n', triangular n')
47+ , testProperty "runner₁ == runner₂"
48+ $ \(ns :: [Integer]) -> property
49+ $ runner1 ns == runner2 ns
50+ ]