forked from Provisdom/defn-spec
-
Notifications
You must be signed in to change notification settings - Fork 0
/
defn_args.cljc
76 lines (62 loc) · 2.31 KB
/
defn_args.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
(ns defn-spec.defn-args
(:require
[clojure.spec.alpha :as s]))
;; taken from https://gist.github.com/viebel/ab64ed95820af42b366889a872dc28ac
;; we need this due to the asymmetry in conform/unform with defn-args, as described
;; here: https://dev.clojure.org/jira/browse/CLJ-2021
(s/def ::local-name (s/and simple-symbol? #(not= '& %)))
(s/def ::binding-form
(s/or :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?
: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?)))))