1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
{-# LANGUAGE NoImplicitPrelude #-}
-- : dep tasty
-- : dep tasty-hunit
-- : dep tasty-quickcheck
module Biz.Test
( Tree,
run,
group,
unit,
prop,
with,
assertFailure,
(@=?),
(@?=),
(@?!=),
)
where
import Alpha hiding (group)
import qualified Data.Text as Text
import qualified Test.Tasty as Tasty
import qualified Test.Tasty.HUnit as HUnit
import qualified Test.Tasty.QuickCheck as QuickCheck
import qualified Test.Tasty.Runners as Tasty
type Tree = Tasty.TestTree
run :: Tree -> IO ()
run tree = do
Tasty.installSignalHandlers
case Tasty.tryIngredients Tasty.defaultIngredients mempty tree of
Nothing -> do
hPutStrLn stderr <| Text.pack "no ingredients agreed to run"
exitFailure
Just act -> act +> \ok -> if ok then exitSuccess else exitFailure
group :: Tasty.TestName -> [Tasty.TestTree] -> Tasty.TestTree
group = Tasty.testGroup
unit :: Tasty.TestName -> HUnit.Assertion -> Tasty.TestTree
unit = HUnit.testCase
prop :: QuickCheck.Testable a => Tasty.TestName -> a -> Tasty.TestTree
prop = QuickCheck.testProperty
assertFailure :: String -> HUnit.Assertion
assertFailure = HUnit.assertFailure
with ::
-- | Startup
IO a ->
-- | Shutdown
(a -> IO ()) ->
-- | A test group where the first argument is a function that gets the resource
(IO a -> Tree) ->
Tree
with = Tasty.withResource
-- | How is this not part of HUnit??
assertNotEqual ::
(Eq a, Show a, HasCallStack) =>
-- | The message prefix
String ->
-- | The not-expected value
a ->
-- | The actual value
a ->
HUnit.Assertion
assertNotEqual preface notexpected actual =
unless (actual /= notexpected) (HUnit.assertFailure msg)
where
msg =
(if null preface then "" else preface ++ "\n")
++ "expected not: "
++ show notexpected
++ "\n but got: "
++ show actual
(@?!=) ::
(Eq a, Show a, HasCallStack) =>
-- | The not-expected value
a ->
-- | The actual value
a ->
HUnit.Assertion
expected @?!= actual = assertNotEqual "" expected actual
infixl 2 @?!=
(@=?) :: (Eq a, Show a) => a -> a -> HUnit.Assertion
a @=? b = a HUnit.@=? b
infixl 2 @=?
(@?=) :: (Eq a, Show a) => a -> a -> HUnit.Assertion
a @?= b = a HUnit.@?= b
infixr 2 @?=
|
