-
Notifications
You must be signed in to change notification settings - Fork 38
/
local_bindings.clj
162 lines (143 loc) · 5.8 KB
/
local_bindings.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
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
159
160
161
162
(ns compliment.sources.local-bindings
"Completion source for local bindings introduced by defn, let and the like."
(:require [compliment.sources :refer [defsource]]
[compliment.sources.vars :refer [var-symbol? dash-matches?]]
[compliment.utils :as utils]))
(defn- let-like-form? [x]
(and (symbol? x)
(contains? #{"let"
"if-let"
"when-let"
"if-some"
"when-some"
"loop"
"with-open"
"dotimes"
"with-local-vars"}
(name x))))
(defn- defn-like-form? [x]
(and (symbol? x)
(contains? #{"defn"
"defn-"
"fn"
"fn*"
"defmacro"
"defmethod"}
(name x))))
(defn- doseq-like-form? [x]
(and (symbol? x)
(contains? #{"doseq" "for"} (name x))))
(defn- letfn-like-form? [x]
(and (symbol? x)
(contains? #{"letfn"} (name x))))
(def destructuring-key-names #{"keys" "strs" "syms"})
(defn extract-tag-from-bound-to [ns bound-to]
(when bound-to
(when-let [found (or (-> bound-to meta :tag)
(utils/var->class ns bound-to)
(utils/invocation-form->class ns bound-to)
(utils/literal->class bound-to))]
(if (class? found)
(-> ^Class found .getName symbol)
found))))
(defn parse-binding
"Given a binding node returns the list of local bindings introduced by that
node. Handles vector and map destructuring."
[ns binding-node bound-to]
(cond (vector? binding-node)
(mapcat (fn [x]
(parse-binding ns x nil))
binding-node)
(map? binding-node)
(let [normal-binds (->> (keys binding-node)
(remove keyword?)
(mapcat (fn [x]
(parse-binding ns x nil))))
keys-binds (->> binding-node
(mapcat (fn [[k v]]
;; This handles both plain and
;; namespaced destructuring keywords.
(when (and (keyword? k)
(destructuring-key-names (name k)))
v)))
(map #(if (keyword? %) (symbol (name %)) %)))
as-bind (:as binding-node)]
(cond-> (concat normal-binds keys-binds)
as-bind (conj as-bind)))
(not (#{'& '_} binding-node))
[(if (-> binding-node meta :tag)
binding-node
(if-let [candidate (extract-tag-from-bound-to ns bound-to)]
(vary-meta binding-node assoc :tag candidate)
binding-node))]))
(defn parse-fn-body
"Extract function name and arglists from the function body, return list of all
completable variables."
[ns fn-body]
(let [fn-name (when (symbol? (first fn-body))
(first fn-body))
fn-body (if fn-name (rest fn-body) fn-body)]
(cond->
(mapcat (fn [x]
(parse-binding ns x nil))
(loop [[c & r] fn-body, bnodes []]
(cond (nil? c) bnodes
(list? c) (recur r (conj bnodes (first c))) ;; multi-arity case
(vector? c) c ;; single-arity case
:else (recur r bnodes))))
fn-name (conj fn-name))))
(defn extract-local-bindings
"When given a form that has a binding vector traverses that binding vector and
returns the list of all local bindings."
[form ns]
(when (seq? form)
(let [sym (first form)
locals-meta (when (symbol? sym)
(:completion/locals (meta (ns-resolve ns sym))))]
(cond (or (let-like-form? sym) (= locals-meta :let))
(mapcat (fn [[x y]]
(parse-binding ns x y))
(partition 2 (second form)))
(or (defn-like-form? sym) (= locals-meta :defn))
(parse-fn-body ns (rest form))
(or (letfn-like-form? sym) (= locals-meta :letfn))
(mapcat (fn [fn-body]
(parse-fn-body ns fn-body))
(second form))
(or (doseq-like-form? sym) (= locals-meta :doseq))
(->> (partition 2 (second form))
(mapcat (fn [[left right]]
(if (= left :let)
(take-nth 2 right) [left])))
(mapcat (fn [x]
(parse-binding ns x nil))))
(= sym 'as->) [(nth form 2)]))))
(defn- distinct-preserve-tags
"Like `distinct` but keeps symbols that have type tag with a higher priority."
[coll]
(->> coll
(sort (fn [x y]
(let [tx (:tag (meta x))
ty (:tag (meta y))]
(cond (and tx (not ty)) -1
(and (not tx) ty) 1
:else 0))))
distinct))
(defn bindings-from-context
"Returns all local bindings that are established inside the given context."
[ctx ns]
(try (->> (mapcat #(extract-local-bindings (:form %) ns) ctx)
(filter symbol?)
distinct-preserve-tags)
(catch Exception ex ())))
(defn candidates
"Returns a list of local bindings inside the context that match prefix."
[prefix ns context]
(when (var-symbol? prefix)
(for [binding (bindings-from-context context ns)
:let [binding (name binding)]
:when (dash-matches? prefix binding)]
{:candidate binding, :type :local})))
(defsource ::local-bindings
:candidates #'candidates
:doc (constantly nil))