speclj/src/cljc/speclj/components.cljc at master · slagyr/speclj · GitHub

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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
(ns speclj.components)

(defprotocol SpecComponent
  (install [this description]))

#?(:cljs
   (extend-protocol SpecComponent
     LazySeq
     (install [this description] (doseq [component (seq this)] (install component description)))
     List
     (install [this description] (doseq [component (seq this)] (install component description)))
     EmptyList
     (install [this description] (doseq [component (seq this)] (install component description)))
     PersistentVector
     (install [this description] (doseq [component (seq this)] (install component description)))
     nil
     (install [_this _description] (throw (ex-info (str "Oops!  It looks like you tried to add 'nil' to a spec.  That's probably not what you wanted.") {})))
     object
     (install [_this _description] (comment "Whatever...  Let them pass.")))

   :default
   (extend-protocol SpecComponent
     Object
     (install [_this _description] (comment "This prohibits multimethod defs, and other stuff.  Don't be so stingy! Let it pass."))
     nil
     (install [_this _description] (throw (Exception. (str "Oops!  It looks like you tried to add 'nil' to a spec.  That's probably not what you wanted."))))
     clojure.lang.Var
     (install [_this _description] (comment "Vars are cool.  Let them pass."))
     clojure.lang.Seqable
     (install [this description] (doseq [component (seq this)] (install component description)))))

(deftype Description [name is-focused? has-focus? ns parent children characteristics tags befores before-alls afters after-alls withs with-alls arounds around-alls loc]
  SpecComponent
  (install [this description]
    (reset! (.-parent this) description)
    (swap! (.-children description) conj this))
  Object
  (#?(:cljr ToString :default toString) [_this] (str "Description: " \" name \")))

(defn new-description
  ([name is-focused? ns] (new-description name is-focused? ns nil))
  ([name is-focused? ns loc]
   (Description. name (atom is-focused?) (atom false) ns (atom nil) (atom []) (atom []) (atom #{}) (atom []) (atom []) (atom []) (atom []) (atom []) (atom []) (atom []) (atom []) loc)))

(defn is-description? [component]
  (instance? Description component))

(declare ^:dynamic *assertions*)
(defn inc-assertions! [] (swap! *assertions* inc))

(def ^:dynamic *source-loc* nil)

(deftype Characteristic [name parent body is-focused? loc]
  SpecComponent
  (install [this description]
    (reset! (.-parent this) description)
    (swap! (.-characteristics description) conj this))
  Object
  (#?(:cljr ToString :default toString) [_this] (str \" name \")))

(defn new-characteristic
  ([name body is-focused?] (new-characteristic name nil body is-focused? nil))
  ([name description body is-focused?] (new-characteristic name description body is-focused? nil))
  ([name description body is-focused? loc]
   (Characteristic. name (atom description) body (atom is-focused?) loc)))

(defn is-characteristic? [component]
  (instance? Characteristic component))

(deftype Before [body]
  SpecComponent
  (install [this description]
    (swap! (.-befores description) conj this)))

(defn new-before [body]
  (Before. body))

(deftype After [body]
  SpecComponent
  (install [this description]
    (swap! (.-afters description) conj this)))

(defn new-after [body]
  (After. body))

(deftype Around [body]
  SpecComponent
  (install [this description]
    (swap! (.-arounds description) conj this)))

(defn new-around [body]
  (Around. body))

(deftype BeforeAll [body]
  SpecComponent
  (install [this description]
    (swap! (.-before-alls description) conj this)))

(defn new-before-all [body]
  (BeforeAll. body))

(deftype AfterAll [body]
  SpecComponent
  (install [this description]
    (swap! (.-after-alls description) conj this)))

(defn new-after-all [body]
  (AfterAll. body))

(deftype AroundAll [body]
  SpecComponent
  (install [this description]
    (swap! (.-around-alls description) conj this)))

(defn new-around-all [body]
  (AroundAll. body))

(deftype With [name body set-var! value bang]
  SpecComponent
  (install [this description]
    (swap! (.-withs description) conj this))
  #?(:cljs cljs.core/IDeref :default clojure.lang.IDeref)
  (#?(:cljs -deref :default deref) [_this]
    (when (= ::none @value)
      (reset! value (body)))
    @value))

(defn reset-with [with]
  (reset! (.-value with) ::none)
  (when (.-bang with) (deref with)))

(defn new-with [name body set-var! bang]
  (let [with (With. name body set-var! (atom ::none) bang)]
    (when bang (deref with)) ; TODO - MDM: This is the wrong place to deref.  Should do it in body right after arounds.
    with))

(deftype WithAll [name body set-var! value bang]
  SpecComponent
  (install [this description]
    (swap! (.-with-alls description) conj this))
  #?(:cljs cljs.core/IDeref :default clojure.lang.IDeref)
  (#?(:cljs -deref :default deref) [_this]
    (when (= ::none @value)
      (reset! value (body)))
    @value))

(defn new-with-all [name body set-var! bang]
  (let [with-all (WithAll. name body set-var! (atom ::none) bang)]
    (when bang (deref with-all))
    with-all))

(deftype Tag [name]
  SpecComponent
  (install [_this description]
    (swap! (.-tags description) conj name)))

(defn new-tag [name]
  (Tag. name))