0 | module Evince.Expectations
  1 |
  2 | import Data.List
  3 | import Decidable.Equality
  4 | import Evince.Core
  5 |
  6 | %default total
  7 |
  8 | ||| Passes if `actual` is decidably equal to `expected`. Uses `DecEq` for
  9 | ||| constructive equality — the primary assertion in evince.
 10 | export
 11 | mustBe : DecEq a => Show a => (actual : a) -> (expected : a) -> TestResult ()
 12 | mustBe actual expected = case decEq actual expected of
 13 |   Yes _ => Pass ()
 14 |   No  _ => Fail $ ExpectedButGot "not equal" (show expected) (show actual)
 15 |
 16 | ||| Passes if `actual` is decidably not equal to `expected`.
 17 | export
 18 | mustNotBe : DecEq a => Show a => (actual : a) -> (expected : a) -> TestResult ()
 19 | mustNotBe actual expected = case decEq actual expected of
 20 |   Yes _ => Fail $ ExpectedButGot "expected to differ" (show expected) (show actual)
 21 |   No  _ => Pass ()
 22 |
 23 | ||| Passes if `actual == expected` via `Eq`. Fallback for types without `DecEq`
 24 | ||| (e.g. `Double`).
 25 | export
 26 | mustEqual : Eq a => Show a => (actual : a) -> (expected : a) -> TestResult ()
 27 | mustEqual actual expected =
 28 |   if actual == expected then Pass ()
 29 |   else Fail $ ExpectedButGot "not equal" (show expected) (show actual)
 30 |
 31 | ||| Passes if `actual /= expected` via `Eq`.
 32 | export
 33 | mustNotEqual : Eq a => Show a => (actual : a) -> (expected : a) -> TestResult ()
 34 | mustNotEqual actual expected =
 35 |   if actual /= expected then Pass ()
 36 |   else Fail $ ExpectedButGot "expected to differ" (show expected) (show actual)
 37 |
 38 | ||| Passes if `pred actual` is `True`.
 39 | export
 40 | mustSatisfy : Show a => (actual : a) -> (pred : a -> Bool) -> TestResult ()
 41 | mustSatisfy actual pred =
 42 |   if pred actual then Pass ()
 43 |   else Fail $ PredicateFailed "predicate not satisfied" (show actual)
 44 |
 45 | ||| Passes if `pred actual` is `False`.
 46 | export
 47 | mustNotSatisfy : Show a => (actual : a) -> (pred : a -> Bool) -> TestResult ()
 48 | mustNotSatisfy actual pred =
 49 |   if not (pred actual) then Pass ()
 50 |   else Fail $ PredicateFailed "predicate unexpectedly satisfied" (show actual)
 51 |
 52 | ||| Passes if the value is `True`.
 53 | export
 54 | mustBeTrue : Bool -> TestResult ()
 55 | mustBeTrue True  = Pass ()
 56 | mustBeTrue False = Fail $ Reason "expected True but got False"
 57 |
 58 | ||| Passes if the value is `False`.
 59 | export
 60 | mustBeFalse : Bool -> TestResult ()
 61 | mustBeFalse False = Pass ()
 62 | mustBeFalse True  = Fail $ Reason "expected False but got True"
 63 |
 64 | ||| Passes if the value is `Just _`.
 65 | export
 66 | mustBeJust : Show a => Maybe a -> TestResult ()
 67 | mustBeJust (Just _)  = Pass ()
 68 | mustBeJust Nothing   = Fail $ Reason "expected Just but got Nothing"
 69 |
 70 | ||| Passes if the value is `Nothing`.
 71 | export
 72 | mustBeNothing : Show a => Maybe a -> TestResult ()
 73 | mustBeNothing Nothing  = Pass ()
 74 | mustBeNothing (Just x) = Fail $ PredicateFailed "expected Nothing but got Just" (show x)
 75 |
 76 | ||| Passes if the value is `Right _`.
 77 | export
 78 | mustBeRight : (Show a, Show b) => Either a b -> TestResult ()
 79 | mustBeRight (Right _) = Pass ()
 80 | mustBeRight (Left x)  = Fail $ PredicateFailed "expected Right but got Left" (show x)
 81 |
 82 | ||| Passes if the value is `Left _`.
 83 | export
 84 | mustBeLeft : (Show a, Show b) => Either a b -> TestResult ()
 85 | mustBeLeft (Left _)  = Pass ()
 86 | mustBeLeft (Right x) = Fail $ PredicateFailed "expected Left but got Right" (show x)
 87 |
 88 | ||| Passes if `needle` is a contiguous subsequence of `haystack`.
 89 | export
 90 | mustContain : Eq a => Show a => (haystack : List a) -> (needle : List a) -> TestResult ()
 91 | mustContain haystack needle =
 92 |   if isInfixOf needle haystack then Pass ()
 93 |   else Fail $ ExpectedButGot "does not contain" (show needle) (show haystack)
 94 |
 95 | ||| Passes if `needle` is not a contiguous subsequence of `haystack`.
 96 | export
 97 | mustNotContain : Eq a => Show a => (haystack : List a) -> (needle : List a) -> TestResult ()
 98 | mustNotContain haystack needle =
 99 |   if not (isInfixOf needle haystack) then Pass ()
100 |   else Fail $ ExpectedButGot "unexpectedly contains" (show needle) (show haystack)
101 |
102 | ||| Passes if the list starts with `prefx`.
103 | export
104 | mustStartWith : Eq a => Show a => (actual : List a) -> (prefx : List a) -> TestResult ()
105 | mustStartWith actual prefx =
106 |   if isPrefixOf prefx actual then Pass ()
107 |   else Fail $ ExpectedButGot "does not start with" (show prefx) (show actual)
108 |
109 | ||| Passes if the list ends with `sufx`.
110 | export
111 | mustEndWith : Eq a => Show a => (actual : List a) -> (sufx : List a) -> TestResult ()
112 | mustEndWith actual sufx =
113 |   if isSuffixOf sufx actual then Pass ()
114 |   else Fail $ ExpectedButGot "does not end with" (show sufx) (show actual)
115 |
116 | ||| Passes if the list is empty.
117 | export
118 | mustBeEmpty : Show a => List a -> TestResult ()
119 | mustBeEmpty [] = Pass ()
120 | mustBeEmpty xs = Fail $ PredicateFailed "expected empty list" (show xs)
121 |
122 | ||| Passes if the list is non-empty.
123 | export
124 | mustNotBeEmpty : List a -> TestResult ()
125 | mustNotBeEmpty [] = Fail $ Reason "expected non-empty list but got []"
126 | mustNotBeEmpty _  = Pass ()
127 |
128 | ||| Unconditionally fails with the given message.
129 | export
130 | mustFail : String -> TestResult ()
131 | mustFail msg = Fail $ Reason msg
132 |
133 | ||| Marks a test as pending (skipped, not counted as failure).
134 | export
135 | pending : TestResult ()
136 | pending = Skip Nothing
137 |
138 | ||| Marks a test as pending with a reason.
139 | export
140 | pendingWith : String -> TestResult ()
141 | pendingWith msg = Skip (Just msg)
142 |
143 | ||| Passes if the IO action returns a value decidably equal to `expected`.
144 | ||| Used with `itIO`.
145 | export covering
146 | mustReturn : DecEq a => Show a => IO a -> a -> IO (TestResult ())
147 | mustReturn action expected = do
148 |   actual <- action
149 |   pure $ actual `mustBe` expected
150 |
151 | ||| Passes if the IO action returns a value equal to `expected` via Eq.
152 | ||| Used with `itIO`. Fallback for types without `DecEq`.
153 | export covering
154 | mustReturnEqual : Eq a => Show a => IO a -> a -> IO (TestResult ())
155 | mustReturnEqual action expected = do
156 |   actual <- action
157 |   pure $ actual `mustEqual` expected
158 |