-
-
Notifications
You must be signed in to change notification settings - Fork 149
/
move_form.clj
196 lines (184 loc) · 11.5 KB
/
move_form.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
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
(ns clojure-lsp.feature.move-form
(:require
[clojure-lsp.dep-graph :as dep-graph]
[clojure-lsp.feature.add-missing-libspec :as f.add-missing-libspec]
[clojure-lsp.feature.file-management :as f.file-management]
[clojure-lsp.parser :as parser]
[clojure-lsp.queries :as q]
[clojure-lsp.refactor.edit :as edit]
[clojure-lsp.shared :as shared]
[medley.core :as medley]
[rewrite-clj.zip :as z]))
(defn drop-ns-from-dest [zloc usages]
(loop [[usage & other-usages] usages
loc zloc]
(if usage
(let [usage-loc (edit/find-at-usage-name loc usage)]
(recur other-usages (z/subedit-> loc
(edit/find-at-usage-name usage)
(z/replace (symbol (name (z/sexpr usage-loc)))))))
loc)))
(defn var-usages-within [zloc uri db]
(let [scope (meta (z/node zloc))
defs (q/find-var-usages-under-form db uri scope)]
(filterv
#(edit/loc-encapsulates-usage? zloc %)
defs)))
(defn var-definitions-within [zloc uri db]
(let [defs (q/find-var-definitions db uri false)]
(filterv
#(edit/loc-encapsulates-usage? zloc %)
defs)))
(defn ^:private determine-ns-edits [local-buckets file-loc def-to-move source-ns source-refer libspec uri db]
(let [other-source-refers (filter #(and (:refer %)
(= (:to %) source-ns)
(not= (:name %) (:name def-to-move)))
(:var-usages local-buckets))
other-source-usages (filter #(and (not (:refer %))
(not (:alias %))
(= (:to %) source-ns)
(not= (:name %) (:name def-to-move)))
(:var-usages local-buckets))
source-require (first (filter #(= (:name %) source-ns)
(:namespace-usages local-buckets)))
remove-source-require? (and source-require (empty? other-source-usages))
namespace-loc (edit/find-namespace file-loc)]
(if-let [add-to-ns-changes (f.add-missing-libspec/add-to-namespace* file-loc libspec db)]
(cond-> add-to-ns-changes
remove-source-require?
(update-in
[0 :loc]
(fn [loc]
(z/subedit->
loc
(edit/find-at-usage source-require)
z/up
z/remove)))
(and (not remove-source-require?) source-refer)
(update-in
[0 :loc]
(fn [loc]
(z/subedit->
loc
(edit/find-at-usage-name source-refer)
z/remove
(cond-> (empty? other-source-refers) (-> z/remove z/remove)))))
:always
(->> (f.add-missing-libspec/cleaning-ns-edits uri db)))
(when (or remove-source-require? source-refer)
(->> [{:loc (cond-> namespace-loc
remove-source-require?
(z/subedit->
(edit/find-at-usage source-require)
z/up
z/remove)
(and (not remove-source-require?) source-refer)
(z/subedit->
(edit/find-at-usage-name source-refer)
z/remove
(cond-> (empty? other-source-refers) (-> z/remove z/remove))))
:range (meta (z/node namespace-loc))}]
(f.add-missing-libspec/cleaning-ns-edits uri db))))))
(defn move-form [zloc source-uri {:keys [db*] :as components} dest-filename]
(let [db @db*
source-nses (vec (dep-graph/ns-names-for-uri db source-uri))
dest-uri (-> dest-filename (shared/absolute-path db) (shared/filename->uri db))
dest-nses (vec (dep-graph/ns-names-for-uri db dest-uri))]
(when (and (= 1 (count source-nses))
(= 1 (count dest-nses)))
(let [source-ns (first source-nses)
dest-ns (first dest-nses)
inner-usages (var-usages-within zloc source-uri db)
;; if source-ns things are used within the form
;; we can't move it
local-inner-usages (->> inner-usages
(filterv (comp #(= source-ns %) :to)))
defs (var-definitions-within zloc source-uri db)
form-loc (edit/to-top zloc)
on-top-level-form? (= form-loc zloc)
;; You could have multiple in a top form (let [x 1] (def y x) (def z y))
;; we don't support that
single-def? (= 1 (count defs))
can-move? (and dest-ns
(empty? local-inner-usages)
on-top-level-form?
single-def?)]
(when can-move?
(let [def-to-move (first defs)
refs (q/find-references db def-to-move false)
dest-refs (filter (comp #(= % dest-uri) :uri) refs)
per-file-usages (group-by :uri refs)
insertion-loc (some-> (f.file-management/force-get-document-text dest-uri components)
parser/z-of-string*
z/down
z/rightmost)
insertion-pos (meta (z/node insertion-loc))
dest-inner-usages (->> inner-usages
(filterv (comp #(= dest-ns %) :to)))
dest-changes (-> [{:loc (z/of-string "\n\n")
:range (assoc insertion-pos :row (:end-row insertion-pos) :col (:end-col insertion-pos))}
{:loc (some-> insertion-loc
(z/insert-left (z/node (-> form-loc
(z/subedit-> (drop-ns-from-dest dest-inner-usages)))))
z/left)
:range (assoc insertion-pos :row (:end-row insertion-pos) :col (:end-col insertion-pos))}]
(into (for [dest-ref (vec dest-refs)
:let [dest-ref-loc (edit/find-at-usage-name insertion-loc dest-ref)]]
{:loc (z/replace dest-ref-loc (symbol (name (z/sexpr dest-ref-loc))))
:range (meta dest-ref-loc)})))
usage-changes-by-uri (->> (dissoc per-file-usages dest-uri)
(medley/map-kv-vals
(fn [file-uri usages]
(let [usage (first usages)
usage-uri (:uri usage)
file-loc (some-> (f.file-management/force-get-document-text file-uri components)
parser/z-of-string*)
db @db*
local-buckets (get-in db [:analysis usage-uri])
source-refer (first (filter #(and (:refer %)
(= (:to %) source-ns)
(= (:name %) (:name def-to-move)))
(:var-usages local-buckets)))
dest-require (first (filter #(= (:name %) dest-ns)
(:namespace-usages local-buckets)))
namespace-suggestions (f.add-missing-libspec/find-namespace-suggestions
(str dest-ns)
(f.add-missing-libspec/find-alias-ns-pairs db source-uri))
suggestion (if dest-require
{:alias (str (:alias dest-require))}
(first namespace-suggestions))
usages (filter #(and (not (:refer %))
(= (:to %) source-ns)
(= (:name %) (:name def-to-move)))
(:var-usages local-buckets))
libspec (merge
{:type :require
:lib dest-ns}
(when suggestion
{:alias (some-> suggestion :alias symbol)})
(when source-refer
{:refer (:name source-refer)}))
ns-changes (determine-ns-edits local-buckets file-loc def-to-move source-ns source-refer libspec source-uri db)
replacement-ns (cond
(:alias libspec)
(:alias libspec)
:else
(:lib libspec))
usage-changes (keep (fn [usage]
(let [usage-loc (edit/find-at-usage-name file-loc usage)]
(when (or
(= source-uri usage-uri)
(namespace (z/sexpr usage-loc)))
{:loc (z/replace usage-loc (symbol (str replacement-ns)
(str (:name def-to-move))))
:range (meta (z/node usage-loc))})))
usages)]
(vec (concat ns-changes usage-changes)))))
not-empty)
changes-by-uri (-> {dest-uri dest-changes}
;; Adjust requires and usages
(merge usage-changes-by-uri)
;; Remove moved form
(update source-uri (fnil conj []) {:loc nil
:range (edit/range-with-left-whitespace zloc)}))]
{:changes-by-uri changes-by-uri}))))))