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
100
101
102
103
104
105
106
107
108
109
110
|
{-# LANGUAGE NoImplicitPrelude #-}
module Biz.Test
( Tree,
Description,
Assertion,
run,
group,
none,
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
type Description = Tasty.TestName
type Assertion = HUnit.Assertion
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 :: Description -> [Tasty.TestTree] -> Tree
group = Tasty.testGroup
unit :: Description -> Assertion -> Tree
unit = HUnit.testCase
prop :: QuickCheck.Testable a => Description -> a -> Tree
prop = QuickCheck.testProperty
assertFailure :: String -> 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
-- | unexpectedValue @?!= actual
(@?!=) ::
(Eq a, Show a, HasCallStack) =>
-- | The not-expected value
a ->
-- | The actual value
a ->
HUnit.Assertion
expected @?!= actual = assertNotEqual "" expected actual
infixl 2 @?!=
-- | expectedVal @=? actualVal
(@=?) :: (Eq a, Show a) => a -> a -> HUnit.Assertion
a @=? b = a HUnit.@=? b
infixl 2 @=?
-- | actualVal @?= expectedVal
(@?=) :: (Eq a, Show a) => a -> a -> HUnit.Assertion
a @?= b = a HUnit.@?= b
infixr 2 @?=
-- | For usage in 'Biz.Cli.Plan' when you have no tests.
none :: Tree
none = group "none" []
|
