summaryrefslogtreecommitdiff
path: root/Biz/Test.hs
blob: 7571008204343d92b70b7d0e4ef7b0bcd6fa80b1 (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
{-# LANGUAGE NoImplicitPrelude #-}

-- : dep tasty
-- : dep tasty-hunit
-- : dep tasty-quickcheck
module Biz.Test
  ( Tree,
    group,
    unit,
    prop,
    with,
    (@=?),
    (@?=),
    (@?!=),
  )
where

import Alpha hiding (group)
import qualified Test.Tasty as Tasty
import Test.Tasty.HUnit ((@=?), (@?=))
import qualified Test.Tasty.HUnit as HUnit
import qualified Test.Tasty.QuickCheck as QuickCheck

type Tree = Tasty.TestTree

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

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