-
Notifications
You must be signed in to change notification settings - Fork 4
/
script.cljc
124 lines (104 loc) · 3.71 KB
/
script.cljc
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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
(ns darkleaf.effect.script
(:refer-clojure :exclude [test])
(:require
[clojure.test :as t]
[clojure.string :as str]))
(defn- with-exceptions [continuation]
(when (some? continuation)
(fn [coeffect]
(try
(let [[effect continuation] (continuation coeffect)
continuation (with-exceptions continuation)]
[effect continuation])
(catch #?(:clj RuntimeException, :cljs js/Error) ex
[ex nil])))))
(defn- exception? [x]
(instance? #?(:clj Throwable, :cljs js/Error) x))
(defn- equal-exceptions? [a b]
(and (= (type a)
(type b))
(= (ex-message a)
(ex-message b))
(= (ex-data a)
(ex-data b))))
(defn- add-message-tag [{:keys [message] :as report} tag]
(cond
(nil? message) report
(nil? tag) report
:else (assoc report :message (str tag " / " message))))
(defn- test-first-item [{:keys [report continuation]} {:keys [args]}]
(let [[effect continuation] (continuation args)]
{:report report
:actual-effect effect
:continuation continuation}))
(defn- test-middle-item [{:keys [report actual-effect continuation]} {:keys [effect coeffect tag]}]
(-> (cond
(not= :pass (:type report))
{:report report}
(nil? continuation)
{:report {:type :fail
:expected effect
:actual actual-effect
:message "Misssed effect"}}
(not= effect actual-effect)
{:report {:type :fail
:expected effect
:actual actual-effect
:message "Wrong effect"}}
:else
(let [[actual-effect continuation] (continuation coeffect)]
{:report report
:actual-effect actual-effect
:continuation continuation}))
(update :report add-message-tag tag)))
(defn- test-middle-items [ctx items]
(reduce test-middle-item ctx items))
(defn- test-last-item [{:keys [report actual-effect continuation]}
{:keys [return final-effect throw tag]}]
(-> (cond
(not= :pass (:type report))
{:report report}
(and (some? final-effect)
(= final-effect actual-effect))
{:report report}
(some? final-effect)
{:report {:type :fail
:expected final-effect
:actual actual-effect
:message "Wrong final effect"}}
(and (some? throw)
(equal-exceptions? throw actual-effect))
{:report report}
(some? throw)
{:report {:type :fail
:expected throw
:actual actual-effect
:message "Wrong exception"}}
(some? continuation)
{:report {:type :fail
:expected nil
:actual actual-effect
:message "Extra effect"}}
(not= return actual-effect)
{:report {:type :fail
:expected return
:actual actual-effect
:message "Wrong return"}}
:else
{:report report})
(update :report add-message-tag tag)))
(defn test* [continuation script]
{:pre [(<= 2 (count script))]}
(let [first-item (first script)
middle-items (-> script rest butlast)
last-item (last script)
continuation (-> continuation
(with-exceptions))]
(-> {:continuation continuation, :report {:type :pass}}
(test-first-item first-item)
(test-middle-items middle-items)
(test-last-item last-item)
:report)))
(defn test [continuation script]
(-> (test* continuation script)
(t/do-report)))