/
testutil.clj
108 lines (91 loc) · 3.7 KB
/
testutil.clj
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
(ns structural-typing.assist.testutil
"Useful shorthand for tests of new code, like custom predicates."
(:use structural-typing.clojure.core)
(:require [structural-typing.guts.exval :as exval]
[structural-typing.assist.oopsie :as oopsie]
[structural-typing.assist.lifting :as lifting]
[structural-typing.type :as type]
[such.readable :as readable]
such.immigration
structural-typing.guts.explanations)
(:refer-clojure :exclude [any?]))
(defn exval
"Generate an \"extended value\". Omitted values are replaced
with useful defaults.
(exval 5 :x) => (exval 5 :x {:x 5})
(exval 5) => (exval 5 :x {:x 5})
"
([leaf-value path whole-value]
(exval/->ExVal leaf-value path whole-value))
([leaf-value path]
(exval leaf-value path (hash-map path leaf-value)))
([leaf-value]
(exval leaf-value [:x])))
(defn lift-and-run
"[[lift-pred]] the `pred` and run it against the [[exval]]."
[pred exval]
( (lifting/lift-pred pred) exval))
(defn explain-lifted
"[[lift-and-run]] the predicate against the [[expred]], then
generate a list of [[explanations]].
Note that it's safe to use this on an already-lifted predicate."
[pred exval]
(oopsie/explanations ((lifting/lift-pred pred) exval)))
;; Don't use Midje checkers to avoid dragging in all of its dependencies
(defn oopsie-for
"Create a function that takes an [[oopsie]] and checks it.
Examples:
... => (oopsie-for 5) ; :leaf-value must be 5, other keys irrelevant
... => (oopsie-for 5 :whole-value {:x 5}) ; two keys relevant, others not.
"
[leaf-value & {:as kvs}]
(let [expected (assoc kvs :leaf-value leaf-value)]
(fn [actual]
(= (select-keys actual (keys expected)) expected))))
(defn both-names
"Generate the readable names of both the original and lifted predicates.
Provoke a test failure if they're not the same. Otherwise, return the value
for further checking.
(both-names (member [1 2 3])) => \"(member [1 2 3])\"
"
[pred]
(let [plain (readable/fn-string pred)
lifted (readable/fn-string (lifting/lift-pred pred))]
(if (= plain lifted)
plain
(format "`%s` mismatches `%s`" plain lifted))))
(defn check-for-explanations
"Run [[built-like]] against the arguments. The result is supposed to be
error messages and a `nil` return value. If not, provoke an error. If so,
return the explanations.
(check-for-explanations :Figure {:points 3}) => (just (err:missing :color))
"
[& args]
(let [[retval output] (val-and-output (apply type/built-like args))]
(if (nil? retval)
(str-split output #"\n") ; too lazy to handle windows.
["Actual return result was not `nil`"])))
(defn check-all-for-explanations
"Same as [[check-for-explanations]] but uses `all-built-like`."
[& args]
(let [[retval output] (val-and-output (apply type/all-built-like args))]
(if (nil? retval)
(str-split output #"\n") ; too lazy to handle windows.
["Actual return result was not `nil`"])))
(import-vars [structural-typing.guts.explanations
err:not-maplike
err:not-collection
err:not-sequential
err:maplike
err:selector-at-nil
err:whole-value-nil
err:value-nil
err:missing])
(defn err:shouldbe
"Produces the same error messsage produced when a predicate not altered by [[explain-with]]
fails."
([path should-be is]
(err:shouldbe path should-be is false))
([path should-be is omit-quotes]
(let [should-be (if omit-quotes should-be (str "`" should-be "`"))]
(format "%s should be %s; it is `%s`" path should-be is))))