Skip to content

Commit 29b96c2

Browse files
CFiggersCFiggers
authored
Merge pull request #13 from CFiggers:formatting
New feature: Document formatting
2 parents 1eb5b1c + 9312225 commit 29b96c2

File tree

6 files changed

+612
-12
lines changed

6 files changed

+612
-12
lines changed

‎libs/fmt.janet

+235
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,235 @@
1+
### This code is based on code that is:
2+
###
3+
### Copyright (c) 2022 Calvin Rose and contributors
4+
###
5+
### Permission is hereby granted, free of charge, to any person obtaining a copy of
6+
### this software and associated documentation files (the "Software"), to deal in
7+
### the Software without restriction, including without limitation the rights to
8+
### use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
9+
### of the Software, and to permit persons to whom the Software is furnished to do
10+
### so, subject to the following conditions:
11+
###
12+
### The above copyright notice and this permission notice shall be included in all
13+
### copies or substantial portions of the Software.
14+
###
15+
### THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16+
### IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17+
### FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18+
### AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19+
### LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20+
### OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21+
### SOFTWARE.
22+
###
23+
### fmt.janet
24+
###
25+
### Janet code formatter.
26+
###
27+
28+
(defn- pnode
29+
"Make a capture function for a node."
30+
[tag]
31+
(fn [x] [tag x]))
32+
33+
(def- parse-peg
34+
"Peg to parse Janet with extra information, namely comments."
35+
(peg/compile
36+
~{:ws (+ (set " \t\r\f\0\v") '"\n")
37+
:readermac (set "';~,|")
38+
:symchars (+ (range "09" "AZ" "az" "\x80\xFF") (set "!$%&*+-./:<?=>@^_"))
39+
:token (some :symchars)
40+
:hex (range "09" "af" "AF")
41+
:escape (* "\\" (+ (set "ntrzfev0ab'?\"\\")
42+
(* "x" :hex :hex)
43+
(* "u" :hex :hex :hex :hex)
44+
(* "U" :hex :hex :hex :hex :hex :hex)
45+
(error (constant "bad hex escape"))))
46+
:comment (/ (* "#" '(any (if-not (+ "\n" -1) 1)) (+ "\n" -1)) ,(pnode :comment))
47+
:span (/ ':token ,(pnode :span))
48+
:bytes '(* "\"" (any (+ :escape (if-not "\"" 1))) "\"")
49+
:string (/ :bytes ,(pnode :string))
50+
:buffer (/ (* "@" :bytes) ,(pnode :buffer))
51+
:long-bytes '{:delim (some "`")
52+
:open (capture :delim :n)
53+
:close (cmt (* (not (> -1 "`")) (-> :n) ':delim) ,=)
54+
:main (drop (* :open (any (if-not :close 1)) :close))}
55+
:long-string (/ :long-bytes ,(pnode :string))
56+
:long-buffer (/ (* "@" :long-bytes) ,(pnode :buffer))
57+
:ptuple (/ (group (* "(" (any :input) (+ ")" (error)))) ,(pnode :ptuple))
58+
:btuple (/ (group (* "[" (any :input) (+ "]" (error)))) ,(pnode :btuple))
59+
:struct (/ (group (* "{" (any :input) (+ "}" (error)))) ,(pnode :struct))
60+
:parray (/ (group (* "@(" (any :input) (+ ")" (error)))) ,(pnode :array))
61+
:barray (/ (group (* "@[" (any :input) (+ "]" (error)))) ,(pnode :array))
62+
:table (/ (group (* "@{" (any :input) (+ "}" (error)))) ,(pnode :table))
63+
:rmform (/ (group (* ':readermac
64+
(group (any :non-form))
65+
:form))
66+
,(pnode :rmform))
67+
:form (choice :rmform
68+
:parray :barray :ptuple :btuple :table :struct
69+
:buffer :string :long-buffer :long-string
70+
:span)
71+
:non-form (choice :ws :comment)
72+
:input (choice :non-form :form)
73+
:main (* (any :input) (+ -1 (error)))}))
74+
75+
(defn- make-tree
76+
"Turn a string of source code into a tree that will be printed"
77+
[source]
78+
[:top (peg/match parse-peg source)])
79+
80+
(defn- remove-extra-newlines
81+
"Remove leading and trailing newlines. Also remove
82+
some extra consecutive newlines."
83+
[node]
84+
(match node
85+
[tag (xs (array? xs))]
86+
(do
87+
(while (= "\n" (array/peek xs)) (array/pop xs)) # remove trailing newlines
88+
(when-let [index (find-index |(not= "\n" $) xs)]
89+
(array/remove xs 0 index)) # remove leading newlines
90+
# remove too many consecutive newlines
91+
(def max-consec (if (= tag :top) 3 2))
92+
(var i 0)
93+
(var consec-count 0)
94+
(while (< i (length xs))
95+
(if (= (in xs i) "\n")
96+
(if (= consec-count max-consec) (array/remove xs i) (do (++ i) (++ consec-count)))
97+
(do (set consec-count 0) (++ i))))
98+
node)
99+
node))
100+
101+
(defdyn *user-indent-2-forms*
102+
"A user list of forms that are control forms and should be indented two spaces.")
103+
104+
(defn- user-indent-2-forms [] (invert (or (dyn *user-indent-2-forms*) [])))
105+
106+
(def- indent-2-forms
107+
"A list of forms that are control forms and should be indented two spaces."
108+
(invert ["fn" "match" "with" "with-dyns" "def" "def-" "var" "var-" "defn" "defn-"
109+
"varfn" "defmacro" "defmacro-" "defer" "edefer" "loop" "seq" "tabseq" "generate" "coro"
110+
"for" "each" "eachp" "eachk" "case" "cond" "defglobal" "varglobal"
111+
"if" "when" "when-let" "when-with" "while" "with-syms" "with-vars"
112+
"if-let" "if-not" "if-with" "let" "short-fn" "try" "unless" "default" "forever" "upscope"
113+
"repeat" "eachy" "forv" "compwhen" "compif" "ev/spawn" "ev/do-thread" "ev/with-deadline"
114+
"label" "prompt"]))
115+
116+
(def- indent-2-peg
117+
"Peg to use to fuzzy match certain forms."
118+
(peg/compile ~(+ "with-" "def" "if-" "when-")))
119+
120+
(defn- check-indent-2
121+
"Check if a tuple needs a 2 space indent or not"
122+
[items]
123+
(if-let [[tag body] (get items 0)]
124+
(cond
125+
(= "\n" (get items 1)) true
126+
(not= tag :span) nil
127+
(in indent-2-forms body) true
128+
(peg/match indent-2-peg body) true
129+
(in (user-indent-2-forms) body) true)))
130+
131+
(defn- fmt
132+
"Emit formatted."
133+
[tree]
134+
135+
(var col 0)
136+
(def ident-stack @[])
137+
(var ident "")
138+
(def white @"")
139+
140+
(defn emit [& xs] (each x xs (+= col (length x)) (prin x)))
141+
(defn indent [&opt delta]
142+
(array/push ident-stack ident)
143+
(set ident (string/repeat " " (+ col (or delta 0)))))
144+
(defn dedent [] (set ident (array/pop ident-stack)))
145+
(defn flushwhite [] (emit white) (buffer/clear white))
146+
(defn dropwhite [] (buffer/clear white))
147+
(defn addwhite [] (buffer/push-string white " "))
148+
(defn newline [] (dropwhite) (print) (buffer/push-string white ident) (set col 0))
149+
150+
# Mutual recursion
151+
(var fmt-1-recur nil)
152+
153+
(defn emit-body
154+
[open xs close &opt delta]
155+
(emit open)
156+
(indent delta)
157+
(each x xs (fmt-1-recur x))
158+
(dropwhite)
159+
(dedent)
160+
(emit close)
161+
(addwhite))
162+
163+
(defn emit-funcall
164+
[xs]
165+
(emit "(")
166+
(def len (length xs))
167+
(when (pos? len)
168+
(fmt-1-recur (xs 0))
169+
(indent 1)
170+
(for i 1 len (fmt-1-recur (xs i)))
171+
(dropwhite)
172+
(dedent))
173+
(emit ")")
174+
(addwhite))
175+
176+
(defn emit-string
177+
[x]
178+
(def parts (interpose "\n" (string/split "\n" x)))
179+
(each p parts (if (= p "\n") (do (newline) (dropwhite)) (emit p))))
180+
181+
(defn emit-rmform
182+
[rm nfs form]
183+
(emit rm)
184+
(each nf nfs
185+
(fmt-1-recur nf))
186+
(fmt-1-recur form))
187+
188+
(defn fmt-1
189+
[node]
190+
(remove-extra-newlines node)
191+
(unless (= node "\n") (flushwhite))
192+
(match node
193+
"\n" (newline)
194+
[:comment x] (do (emit "#" x) (newline))
195+
[:span x] (do (emit x) (addwhite))
196+
[:string x] (do (emit-string x) (addwhite))
197+
[:buffer x] (do (emit "@") (emit-string x) (addwhite))
198+
[:array xs] (emit-body "@[" xs "]")
199+
[:btuple xs] (emit-body "[" xs "]")
200+
[:ptuple xs] (if (check-indent-2 xs)
201+
(emit-body "(" xs ")" 1)
202+
(emit-funcall xs))
203+
[:struct xs] (emit-body "{" xs "}")
204+
[:table xs] (emit-body "@{" xs "}")
205+
[:rmform [rm nfs form]] (emit-rmform rm nfs form)
206+
[:top xs] (emit-body "" xs "")))
207+
208+
(set fmt-1-recur fmt-1)
209+
(fmt-1 tree)
210+
(newline)
211+
(flush))
212+
213+
#
214+
# Public API
215+
#
216+
217+
(defn format-print
218+
"Format a string of source code and print the result."
219+
[source]
220+
(-> source make-tree fmt))
221+
222+
(defn format
223+
"Format a string of source code to a buffer."
224+
[source]
225+
(def out @"")
226+
(with-dyns [:out out]
227+
(format-print source))
228+
out)
229+
230+
(defn format-file
231+
"Format a file"
232+
[file]
233+
(def source (slurp file))
234+
(def out (format source))
235+
(spit file out))

‎project.janet

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
(declare-project
22
:name "janet-lsp"
33
:description "A Language Server (LSP) for the Janet Programming Language"
4-
:version "0.0.2"
4+
:version "0.0.3"
55
:dependencies ["https://github.com/janet-lang/spork.git"
66
"https://github.com/ianthehenry/judge.git"])
77

‎src/doc.janet

+2-2
Original file line numberDiff line numberDiff line change
@@ -74,7 +74,7 @@
7474
(defn get-signature
7575
"Look up the signature of a symbol in a given environment."
7676
[sym]
77-
(logging/log (string/format "get-signature tried %m" ((dyn :eval-env) sym)))
77+
(comment logging/log (string/format "get-signature tried %m" ((dyn :eval-env) sym)))
7878
(if-let [x ((dyn :eval-env) sym)]
7979
(-> (string/split "\n" (x :doc))
8080
(array/slice nil 1)
@@ -90,7 +90,7 @@
9090
(defn my-doc*
9191
"Get the documentation for a symbol in a given environment."
9292
[sym env]
93-
(logging/log (string/format "my-doc* tried: %m" ((dyn :eval-env) sym)))
93+
(comment logging/log (string/format "my-doc* tried: %m" ((dyn :eval-env) sym)))
9494
(if-let [x ((dyn :eval-env) sym)]
9595
(make-module-entry x)
9696
(if (has-value? '[break def do fn if quasiquote quote

‎src/main.janet

+33-9
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
(import ../libs/jayson :prefix "json/")
2-
# (import spork/json)
2+
(import ../libs/fmt)
33
(import spork/path)
44
(import spork/argparse)
55
(import ./rpc)
@@ -10,6 +10,8 @@
1010

1111
(use judge)
1212

13+
(def version "0.0.3")
14+
1315
(def jpm-defs (require "../libs/jpm-defs"))
1416

1517
(eachk k jpm-defs
@@ -57,6 +59,20 @@
5759
[:ok state {:kind "full"
5860
:items items}]))
5961

62+
(defn on-document-formatting [state params]
63+
(let [uri (get-in params ["textDocument" "uri"])
64+
content (get-in state [:documents uri :content])
65+
new-content (freeze (fmt/format (string/slice content)))]
66+
(comment logging/log (string/format "old content: %m" content))
67+
(comment logging/log (string/format "new content: %m" new-content))
68+
(comment logging/log (string/format "formatting changed something: %m" (not= content new-content)))
69+
(if (= content new-content)
70+
[:ok state :json/null]
71+
(do (put-in state [:documents uri] {:content new-content})
72+
[:ok state [{:range {:start {:line 0 :character 0}
73+
:end {:line 1000000 :character 1000000}}
74+
:newText new-content}]]))))
75+
6076
(defn on-document-open [state params]
6177
(let [content (get-in params ["textDocument" "text"])
6278
uri (get-in params ["textDocument" "uri"])]
@@ -150,12 +166,12 @@
150166
{"line" line "character" character} (get params "position")
151167
{:source sexp-text :range [start end]} (lookup/sexp-at {:line line :character character} content)
152168
function-symbol (first (peg/match '(* "(" (any :s) (<- (to " "))) sexp-text))
153-
_ (logging/log (string/format "signature help request for: %s" function-symbol))
169+
# _ (logging/log (string/format "signature help request for: %s" function-symbol))
154170
# [fn-name & params] (doc/get-signature (symbol function-symbol))
155171
# _ (logging/log (string/format "got fn-name: %s" fn-name))
156172
# _ (logging/log (string/format "got params: %q" params))
157173
signature (doc/get-signature (symbol function-symbol))
158-
_ (logging/log (string/format "got signature: %s" signature))]
174+
# _ (logging/log (string/format "got signature: %s" signature))]
159175
[:ok state (match signature
160176
nil :json/null
161177
_ [{:label signature}])]))
@@ -173,10 +189,10 @@
173189
:diagnosticProvider {:interFileDependencies true
174190
:workspaceDiagnostics false}
175191
:hoverProvider true
176-
# :signatureHelpProvider {:triggerCharacters [" "]}
177-
}
192+
#:signatureHelpProvider {:triggerCharacters [" "]}
193+
:documentFormattingProvider true}
178194
:serverInfo {:name "janet-lsp"
179-
:version "0.0.1"}}])
195+
:version version}}])
180196

181197
(defn on-shutdown
182198
``
@@ -196,11 +212,18 @@
196212
(quit 1))
197213
[:exit])
198214

215+
(defn on-janet-serverinfo
216+
``
217+
Called by the LSP client to request information about the server.
218+
``
219+
[state params]
220+
[:ok state :json/null])
221+
199222
(defn handle-message [message state]
200223
(let [id (get message "id")
201224
method (get message "method")
202225
params (get message "params")]
203-
(logging/log (string/format "handle-message received method request: %m" method))
226+
(comment logging/log (string/format "handle-message received method request: %m" method))
204227
(case method
205228
"initialize" (on-initialize state params)
206229
"initialized" [:noresponse state]
@@ -209,8 +232,9 @@
209232
"textDocument/completion" (on-completion state params)
210233
"completionItem/resolve" (on-completion-item-resolve state params)
211234
"textDocument/diagnostic" (on-document-diagnostic state params)
235+
"textDocument/formatting" (on-document-formatting state params)
212236
"textDocument/hover" (on-document-hover state params)
213-
"textDocument/signatureHelp" (on-signature-help state params)
237+
"janet/serverInfo" (on-janet-serverinfo state params)
214238
"shutdown" (on-shutdown state params)
215239
"exit" (on-exit state params)
216240
[:noresponse state])))
@@ -350,7 +374,7 @@
350374

351375
(setdyn :eval-env (make-env root-env))
352376

353-
(merge-module (dyn :eval-env) (((curenv) 'module/paths) :value))
377+
# (merge-module (dyn :eval-env) (((curenv) 'module/paths) :value))
354378
(merge-module (dyn :eval-env) jpm-defs)
355379

356380
(each path (find-unique-paths (find-all-module-files (os/cwd) (not (cli-args "dont-search-jpm-tree"))))

0 commit comments

Comments
 (0)