summaryrefslogtreecommitdiff
path: root/Omni/Test.hs
blob: 0cc00ac52970bdaf904ca2bb84e0f4a435272680 (plain)
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 Omni.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 'Omni.Cli.Plan' when you have no tests.
none :: Tree
none = group "none" []