-
Notifications
You must be signed in to change notification settings - Fork 0
/
defn.cljc
88 lines (73 loc) · 2.59 KB
/
defn.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
(ns quark.spec.defn
(:require #?@(:clj [[clojure.spec.alpha :as s]]
:cljs [[cljs.spec.alpha :as s]])))
;; loaded from gist:
;; https://gist.github.com/viebel/ab64ed95820af42b366889a872dc28ac
(s/def ::local-name (s/and simple-symbol? #(not= '& %)))
(def spec-delimiter? #{:-})
(s/def ::spec
(s/cat :delimiter spec-delimiter?
:spec any?))
(s/def ::binding-form
(s/alt :spec ::spec
:sym ::local-name
:seq ::seq-binding-form
:map ::map-binding-form))
;; sequential destructuring
(s/def ::seq-binding-form
(s/and vector?
(s/conformer identity vec)
(s/cat :elems (s/* ::binding-form)
:rest (s/? (s/cat :amp #{'&}
:form ::binding-form))
:as (s/? (s/cat :as #{:as}
:sym ::local-name)))))
;; map destructuring
(s/def ::keys (s/coll-of ident? :kind vector?))
(s/def ::syms (s/coll-of symbol? :kind vector?))
(s/def ::strs (s/coll-of simple-symbol? :kind vector?))
(s/def ::or (s/map-of simple-symbol? any?))
(s/def ::as ::local-name)
(s/def ::map-special-binding (s/keys :opt-un [::as ::or ::keys ::syms ::strs]))
(s/def ::map-binding (s/tuple ::binding-form any?))
(s/def ::ns-keys
(s/tuple (s/and qualified-keyword?
#(-> %
name
#{"keys" "syms"}))
(s/coll-of simple-symbol? :kind vector?)))
(s/def ::map-bindings
(s/every (s/or :mb ::map-binding
:nsk ::ns-keys
:msb (s/tuple #{:as :or :keys :syms :strs} any?))
:into {}))
(s/def ::map-binding-form (s/merge ::map-bindings ::map-special-binding))
;; bindings
(s/def ::binding
(s/cat :binding ::binding-form
:init-expr any?))
(s/def ::bindings (s/and vector? (s/* ::binding)))
;; defn, defn-, fn
(defn arg-list-unformer
[a]
(vec (if (and (coll? (last a)) (= '& (first (last a))))
(concat (drop-last a) (last a))
a)))
(s/def ::arg-list
(s/and vector?
(s/conformer identity arg-list-unformer)
(s/cat :args (s/* ::binding-form)
:varargs (s/? (s/cat :amp #{'&}
:form ::binding-form)))))
(s/def ::args+body
(s/cat :args ::arg-list
:prepost (s/? map?)
:body (s/* any?)))
(s/def ::defn-args
(s/cat :name simple-symbol?
:spec (s/? ::spec)
:docstring (s/? string?)
:meta (s/? map?)
:bs (s/alt :arity-1 ::args+body
:arity-n (s/cat :bodies (s/+ (s/spec ::args+body))
:attr (s/? map?)))))