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 : (Applicative m, DecEq a, Show a) => (actual : a) -> (expected : a) -> TestResultT m ()
 12 | mustBe actual expected = liftResult $ 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 : (Applicative m, DecEq a, Show a) => (actual : a) -> (expected : a) -> TestResultT m ()
 19 | mustNotBe actual expected = liftResult $ 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 : (Applicative m, Eq a, Show a) => (actual : a) -> (expected : a) -> TestResultT m ()
 27 | mustEqual actual expected = liftResult $
 28 |   if actual == expected then Pass ()
 29 |   else Fail $ ExpectedButGot "not equal" (show expected) (show actual)
 30 |
 31 | ||| Passes if `rel actual expected` holds. Fallback for comparisons `Eq`
 32 | ||| can't express, such as approximate or NaN-reflexive equality on `Double`.
 33 | export
 34 | mustEqualBy : (Applicative m, Show a) => (rel : a -> a -> Bool) -> (actual, expected : a) -> TestResultT m ()
 35 | mustEqualBy rel actual expected = liftResult $
 36 |   if rel actual expected then Pass ()
 37 |   else Fail $ ExpectedButGot "not related by the given predicate" (show expected) (show actual)
 38 |
 39 | ||| Passes if `actual /= expected` via `Eq`.
 40 | export
 41 | mustNotEqual : (Applicative m, Eq a, Show a) => (actual : a) -> (expected : a) -> TestResultT m ()
 42 | mustNotEqual actual expected = liftResult $
 43 |   if actual /= expected then Pass ()
 44 |   else Fail $ ExpectedButGot "expected to differ" (show expected) (show actual)
 45 |
 46 | ||| Passes if `pred actual` is `True`.
 47 | export
 48 | mustSatisfy : (Applicative m, Show a) => (actual : a) -> (pred : a -> Bool) -> TestResultT m ()
 49 | mustSatisfy actual pred = liftResult $
 50 |   if pred actual then Pass ()
 51 |   else Fail $ PredicateFailed "predicate not satisfied" (show actual)
 52 |
 53 | ||| Passes if `pred actual` is `False`.
 54 | export
 55 | mustNotSatisfy : (Applicative m, Show a) => (actual : a) -> (pred : a -> Bool) -> TestResultT m ()
 56 | mustNotSatisfy actual pred = liftResult $
 57 |   if not (pred actual) then Pass ()
 58 |   else Fail $ PredicateFailed "predicate unexpectedly satisfied" (show actual)
 59 |
 60 | ||| Passes if the value is `True`.
 61 | export
 62 | mustBeTrue : Applicative m => Bool -> TestResultT m ()
 63 | mustBeTrue True  = liftResult $ Pass ()
 64 | mustBeTrue False = liftResult $ Fail $ Reason "expected True but got False"
 65 |
 66 | ||| Passes if the value is `False`.
 67 | export
 68 | mustBeFalse : Applicative m => Bool -> TestResultT m ()
 69 | mustBeFalse False = liftResult $ Pass ()
 70 | mustBeFalse True  = liftResult $ Fail $ Reason "expected False but got True"
 71 |
 72 | ||| Passes if the value is `Just _`.
 73 | export
 74 | mustBeJust : Applicative m => Maybe a -> TestResultT m ()
 75 | mustBeJust (Just _)  = liftResult $ Pass ()
 76 | mustBeJust Nothing   = liftResult $ Fail $ Reason "expected Just but got Nothing"
 77 |
 78 | ||| Passes if the value is `Nothing`.
 79 | export
 80 | mustBeNothing : (Applicative m, Show a) => Maybe a -> TestResultT m ()
 81 | mustBeNothing Nothing  = liftResult $ Pass ()
 82 | mustBeNothing (Just x) = liftResult $ Fail $ PredicateFailed "expected Nothing but got Just" (show x)
 83 |
 84 | ||| Passes if the value is `Right _`.
 85 | export
 86 | mustBeRight : (Applicative m, Show a) => Either a b -> TestResultT m ()
 87 | mustBeRight (Right _) = liftResult $ Pass ()
 88 | mustBeRight (Left x)  = liftResult $ Fail $ PredicateFailed "expected Right but got Left" (show x)
 89 |
 90 | ||| Passes if the value is `Left _`.
 91 | export
 92 | mustBeLeft : (Applicative m, Show b) => Either a b -> TestResultT m ()
 93 | mustBeLeft (Left _)  = liftResult $ Pass ()
 94 | mustBeLeft (Right x) = liftResult $ Fail $ PredicateFailed "expected Left but got Right" (show x)
 95 |
 96 | ||| Passes if `needle` is a contiguous subsequence of `haystack`.
 97 | export
 98 | mustContain : (Applicative m, Eq a, Show a) => (haystack : List a) -> (needle : List a) -> TestResultT m ()
 99 | mustContain haystack needle = liftResult $
100 |   if isInfixOf needle haystack then Pass ()
101 |   else Fail $ ExpectedButGot "does not contain" (show needle) (show haystack)
102 |
103 | ||| Passes if `needle` is not a contiguous subsequence of `haystack`.
104 | export
105 | mustNotContain : (Applicative m, Eq a, Show a) => (haystack : List a) -> (needle : List a) -> TestResultT m ()
106 | mustNotContain haystack needle = liftResult $
107 |   if not (isInfixOf needle haystack) then Pass ()
108 |   else Fail $ ExpectedButGot "unexpectedly contains" (show needle) (show haystack)
109 |
110 | ||| Passes if the list starts with `prefx`.
111 | export
112 | mustStartWith : (Applicative m, Eq a, Show a) => (actual : List a) -> (prefx : List a) -> TestResultT m ()
113 | mustStartWith actual prefx = liftResult $
114 |   if isPrefixOf prefx actual then Pass ()
115 |   else Fail $ ExpectedButGot "does not start with" (show prefx) (show actual)
116 |
117 | ||| Passes if the list ends with `sufx`.
118 | export
119 | mustEndWith : (Applicative m, Eq a, Show a) => (actual : List a) -> (sufx : List a) -> TestResultT m ()
120 | mustEndWith actual sufx = liftResult $
121 |   if isSuffixOf sufx actual then Pass ()
122 |   else Fail $ ExpectedButGot "does not end with" (show sufx) (show actual)
123 |
124 | ||| Passes if the list is empty.
125 | export
126 | mustBeEmpty : (Applicative m, Show a) => List a -> TestResultT m ()
127 | mustBeEmpty [] = liftResult $ Pass ()
128 | mustBeEmpty xs = liftResult $ Fail $ PredicateFailed "expected empty list" (show xs)
129 |
130 | ||| Passes if the list is non-empty.
131 | export
132 | mustNotBeEmpty : Applicative m => List a -> TestResultT m ()
133 | mustNotBeEmpty [] = liftResult $ Fail $ Reason "expected non-empty list but got []"
134 | mustNotBeEmpty _  = liftResult $ Pass ()
135 |
136 | ||| Unconditionally fails with the given message.
137 | export
138 | mustFail : Applicative m => String -> TestResultT m ()
139 | mustFail msg = liftResult $ Fail $ Reason msg
140 |
141 | ||| Marks a test as pending (skipped, not counted as failure).
142 | export
143 | pending : Applicative m => TestResultT m ()
144 | pending = liftResult $ Skip Nothing
145 |
146 | ||| Marks a test as pending with a reason.
147 | export
148 | pendingWith : Applicative m => String -> TestResultT m ()
149 | pendingWith msg = liftResult $ Skip (Just msg)
150 |
151 | ||| Passes if the action returns a value decidably equal to `expected`.
152 | ||| The action runs in the chain's monad.
153 | export covering
154 | mustReturn : (Monad m, DecEq a, Show a) => m a -> a -> TestResultT m ()
155 | mustReturn action expected = do
156 |   actual <- lift action
157 |   actual `mustBe` expected
158 |
159 | ||| Passes if the action returns a value equal to `expected` via Eq.
160 | ||| Fallback for types without `DecEq`.
161 | export covering
162 | mustReturnEqual : (Monad m, Eq a, Show a) => m a -> a -> TestResultT m ()
163 | mustReturnEqual action expected = do
164 |   actual <- lift action
165 |   actual `mustEqual` expected
166 |