-
-
Notifications
You must be signed in to change notification settings - Fork 149
/
parser.clj
132 lines (116 loc) · 5.27 KB
/
parser.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
(ns clojure-lsp.parser
(:require
[clojure-lsp.refactor.edit :as edit]
[clojure.string :as string]
[lsp4clj.protocols.logger :as logger]
[rewrite-clj.node :as n]
[rewrite-clj.zip :as z]))
(set! *warn-on-reflection* true)
#_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
(defmacro zspy [loc]
`(do
(taoensso.timbre/warn '~loc (pr-str (z/sexpr ~loc)))
~loc))
(defn same-range? [{:keys [name-row name-col name-end-row name-end-col] :as _a-pos}
{r :name-row c :name-col er :name-end-row ec :name-end-col :as _b-pos}]
(and (= r name-row)
(= er name-end-row)
(= c name-col)
(= ec name-end-col)))
(def ^:private zero-width-space
"A unicode character that is incredibly unlikely to be used in regular code.
During parsing, used as a valid and easily identified subsitute for what would
otherwise be an invalid character. This character was chosen because
rewrite-clj parses it as a single character in a symbol, not as whitespace,
and because a zero-width space is invisible and so has little use in source
code."
"\u200b")
(defn ^:private replace-incomplete-token [s invalid-str valid-str]
(let [token-pattern (re-pattern (str invalid-str "(\\s|\\n|\\)|\\]|\\})"))
matcher (re-matcher token-pattern s)]
(loop [[_ divider] (re-find matcher)
new-s s]
(if divider
(recur (re-find matcher)
(string/replace-first new-s token-pattern (str valid-str divider)))
new-s))))
(defn ^:private z-replace-preserving-meta [zloc replacement]
(z/replace zloc (with-meta replacement (meta (z/node zloc)))))
(defn ^:private handle-end-slash-code [text exception]
(when-let [[_ token] (->> exception
Throwable->map
:cause
(re-matches #"Invalid symbol: (.*)\/."))]
(let [real-value (str token "/")
temporary-value (str token zero-width-space)]
(some-> text
(replace-incomplete-token real-value temporary-value)
z/of-string
(z/edit->
(z/find-value z/next (symbol temporary-value))
(z-replace-preserving-meta (n/token-node (symbol real-value))))))))
(defn ^:private handle-single-colon-code [text exception]
(let [cause (->> exception Throwable->map :cause)]
(when (or (re-matches #"\[line (\d+), col (\d+)\] A single colon is not a valid keyword." cause)
(re-matches #"\[line (\d+), col (\d+)\] Invalid keyword: ." cause))
(let [real-value ":"
temporary-value zero-width-space]
(some-> text
(replace-incomplete-token real-value temporary-value)
z/of-string
(z/edit->
(z/find-value z/next (symbol temporary-value))
(z-replace-preserving-meta (n/token-node (symbol real-value)))))))))
(defn ^:private handle-keyword-with-end-slash-code [text exception]
(when-let [[_ token] (->> exception
Throwable->map
:cause
(re-matches #".*Invalid keyword: (.+)\/."))]
(let [real-value (str token "/")
temporary-value (str token zero-width-space)]
(when-let [replaced-node (some-> text
(replace-incomplete-token (str ":" real-value)
(str ":" temporary-value))
z/of-string)]
(if (z/find-value replaced-node z/next (keyword temporary-value))
(z/edit-> replaced-node
(z/find-value z/next (keyword temporary-value))
(z-replace-preserving-meta (n/keyword-node (keyword real-value))))
(z/edit-> replaced-node
(z/find-token z/next #(= (str "::" temporary-value) (z/string %)))
(z-replace-preserving-meta (n/keyword-node (keyword (str ":" real-value))))))))))
(defn zloc-of-string [text]
(try
(z/of-string text)
(catch clojure.lang.ExceptionInfo e
(or (handle-end-slash-code text e)
(handle-keyword-with-end-slash-code text e)
(handle-single-colon-code text e)
(throw e)))))
(defn safe-zloc-of-string [text]
;; TODO: only used by tests.
(try
(zloc-of-string text)
(catch Exception _e
(println "It was not possible to parse text. Probably not valid clojure code."))))
(defn zloc-of-file [db uri]
(zloc-of-string (get-in db [:documents uri :text])))
(defn safe-zloc-of-file [db uri]
(try
(zloc-of-file db uri)
(catch Exception _
(logger/warn "It was not possible to parse file. Probably not valid clojure code."))))
(defn to-pos [zloc row col]
(edit/find-at-pos zloc row col))
(defn to-cursor [zloc line character]
(to-pos zloc (inc line) (inc character)))
(defn lein-zloc->edn [zloc]
(when-let [zloc (some-> zloc
(z/find-next-value z/next 'defproject)
z/remove ;; remove defproject
z/down
z/remove ;; remove project name
z/down
z/remove ;; remove version
)]
(z/sexpr (z/replace zloc (n/map-node (n/children (z/node zloc)))))))