fey.naomi/fennel-ls
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Rename self->server

Browse Source
This commit is contained in:
XeroOl 2024-06-01 23:02:37 -05:00
parent bb47e723a6
commit 0b3d1b47a5
9 changed files with 209 additions and 210 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/fennel-ls/compiler.fnl
View File

@ -46,16 +46,16 @@ identifiers are declared / referenced in which places."
(tset self key val) (tset self key val)
val))}) val))})
(λ line+byte->range [self file line byte] (λ line+byte->range [server file line byte]
(let [line (- line 1) (let [line (- line 1)
;; some errors in fennel erroneously say column -1 ;; some errors in fennel erroneously say column -1
;; try compiling "(do\n" to see what I mean ;; try compiling "(do\n" to see what I mean
byte (math.max 0 byte) byte (math.max 0 byte)
position (utils.pos->position file.text line byte self.position-encoding)] position (utils.pos->position file.text line byte server.position-encoding)]
{:start position :end position})) {:start position :end position}))
(λ compile [{:configuration {: macro-path} :root-uri ?root-uri &as self} file] (λ compile [{:configuration {: macro-path} :root-uri ?root-uri &as server} file]
"Compile the file, and record all the useful information from the compiler into the file object" "Compile the file, and record all the useful information from the compiler into the file object"
;; The useful information being recorded: ;; The useful information being recorded:
(let [definitions-by-scope (doto {} (setmetatable has-tables-mt)) (let [definitions-by-scope (doto {} (setmetatable has-tables-mt))
@ -79,7 +79,7 @@ identifiers are declared / referenced in which places."
;; find reference ;; find reference
(let [name (string.match (tostring symbol) "[^%.:]+")] (let [name (string.match (tostring symbol) "[^%.:]+")]
(case (or (find-definition (tostring name) scope) (case (or (find-definition (tostring name) scope)
(docs.get-global self name)) (docs.get-global server name))
target (let [ref {: symbol : target : ref-type}] target (let [ref {: symbol : target : ref-type}]
(tset references symbol ref) (tset references symbol ref)
(when target.referenced-by (when target.referenced-by
@ -264,8 +264,8 @@ identifiers are declared / referenced in which places."
true)))) true))))
(λ on-compile-error [_ msg ast call-me-to-reset-the-compiler] (λ on-compile-error [_ msg ast call-me-to-reset-the-compiler]
(let [range (or (message.ast->range self file ast) (let [range (or (message.ast->range server file ast)
(line+byte->range self file 1 1))] (line+byte->range server file 1 1))]
(table.insert diagnostics (table.insert diagnostics
{:range range {:range range
:message msg :message msg
@ -280,7 +280,7 @@ identifiers are declared / referenced in which places."
(λ on-parse-error [msg filename line byte _source call-me-to-reset-the-compiler] (λ on-parse-error [msg filename line byte _source call-me-to-reset-the-compiler]
(let [line (if (= line "?") 1 line) (let [line (if (= line "?") 1 line)
range (line+byte->range self file line byte)] range (line+byte->range server file line byte)]
(table.insert diagnostics (table.insert diagnostics
{:range range {:range range
:message msg :message msg
@ -293,8 +293,8 @@ identifiers are declared / referenced in which places."
(call-me-to-reset-the-compiler) (call-me-to-reset-the-compiler)
(error "__NOT_AN_ERROR")))) (error "__NOT_AN_ERROR"))))
(local allowed-globals (docs.get-all-globals self)) (local allowed-globals (docs.get-all-globals server))
(each [_ v (ipairs (utils.split-spaces self.configuration.extra-globals))] (each [_ v (ipairs (utils.split-spaces server.configuration.extra-globals))]
(table.insert allowed-globals v)) (table.insert allowed-globals v))
;; TODO clean up this code. It's awful now that there is error handling ;; TODO clean up this code. It's awful now that there is error handling
@ -329,7 +329,7 @@ identifiers are declared / referenced in which places."
(error (.. "\nYou have crashed fennel-ls (or the fennel " component ") with the following message\n:" err (error (.. "\nYou have crashed fennel-ls (or the fennel " component ") with the following message\n:" err
"\n\n^^^ the error message above here is the root problem\n\n")) "\n\n^^^ the error message above here is the root problem\n\n"))
(table.insert diagnostics (table.insert diagnostics
{:range (line+byte->range self file 1 1) {:range (line+byte->range server file 1 1)
:message (.. "unrecoverable " component " error: " err)})))) :message (.. "unrecoverable " component " error: " err)}))))
parser (let [p (fennel.parser file.text file.uri opts)] parser (let [p (fennel.parser file.text file.uri opts)]

28
src/fennel-ls/dispatch.fnl
View File

@ -10,12 +10,12 @@ In general, this involves:
(local handlers (require :fennel-ls.handlers)) (local handlers (require :fennel-ls.handlers))
(local message (require :fennel-ls.message)) (local message (require :fennel-ls.message))
(λ handle-request [self send id method ?params] (λ handle-request [server send id method ?params]
;; Call the appropriate request handler. ;; Call the appropriate request handler.
;; The return value of the request is sent back to the server. ;; The return value of the request is sent back to the server.
(case (. handlers.requests method) (case (. handlers.requests method)
callback callback
(case (callback self send ?params) (case (callback server send ?params)
(nil err) (send (message.create-error :InternalError err id)) (nil err) (send (message.create-error :InternalError err id))
?response (send (message.create-response id ?response))) ?response (send (message.create-response id ?response)))
nil nil
@ -25,47 +25,47 @@ In general, this involves:
(.. "\"" method "\" is not in the request-handlers table") (.. "\"" method "\" is not in the request-handlers table")
id)))) id))))
(λ handle-response [self send id result] (λ handle-response [server send id result]
;; I don't care about responses yet ;; I don't care about responses yet
nil) nil)
(λ handle-bad-response [self send id err] (λ handle-bad-response [server send id err]
;; Handle a message indicating an error. Right now, it just crashes the server. ;; Handle a message indicating an error. Right now, it just crashes the server.
(error (.. "Client sent fennel-ls an error: " err.code))) (error (.. "Client sent fennel-ls an error: " err.code)))
(λ handle-notification [self send method ?params] (λ handle-notification [server send method ?params]
;; Call the appropriate notification handler. ;; Call the appropriate notification handler.
(case (. handlers.notifications method) (case (. handlers.notifications method)
callback (callback self send ?params))) callback (callback server send ?params)))
;; Silent error for unknown notifications ;; Silent error for unknown notifications
(λ handle [self send msg] (λ handle [server send msg]
"Figures out what to do with a message. "Figures out what to do with a message.
This can involve updating the state of the server, and/or sending messages to the This can involve updating the state of the server, and/or sending messages to the
server. server.
Takes: Takes:
* `self`, which is the state of the server, * `server`, which is the state of the server,
* `send`, which is a callback for sending responses, and * `send`, which is a callback for sending responses, and
* `msg`, which is the message to receive." * `msg`, which is the message to receive."
(case (values msg (type msg)) (case (values msg (type msg))
{:jsonrpc "2.0" : id : method :params ?params} {:jsonrpc "2.0" : id : method :params ?params}
(handle-request self send id method ?params) (handle-request server send id method ?params)
{:jsonrpc "2.0" : method :params ?params} {:jsonrpc "2.0" : method :params ?params}
(handle-notification self send method ?params) (handle-notification server send method ?params)
{:jsonrpc "2.0" : id : result} {:jsonrpc "2.0" : id : result}
(handle-response self send id result) (handle-response server send id result)
{:jsonrpc "2.0" : id :error err} {:jsonrpc "2.0" : id :error err}
(handle-bad-response self send id err) (handle-bad-response server send id err)
(str :string) (str :string)
(send (message.create-error :ParseError str)) (send (message.create-error :ParseError str))
_ _
(send (message.create-error :BadMessage nil msg.id)))) (send (message.create-error :BadMessage nil msg.id))))
(λ handle* [self msg] (λ handle* [server msg]
"handles a message, and returns all the responses in a table" "handles a message, and returns all the responses in a table"
(let [out []] (let [out []]
(handle self (partial table.insert out) msg) (handle server (partial table.insert out) msg)
out)) out))
{: handle {: handle

14
src/fennel-ls/docs.fnl
View File

@ -35,25 +35,25 @@
(fennel.view (doto (icollect [key (pairs libraries)] key) table.sort))))) (fennel.view (doto (icollect [key (pairs libraries)] key) table.sort)))))
(. libraries library)) (. libraries library))
(fn get-all-globals [self] (fn get-all-globals [server]
(let [result []] (let [result []]
(each [_ library (ipairs self.configuration.native-libraries)] (each [_ library (ipairs server.configuration.native-libraries)]
(icollect [name (pairs (get-native-library library)) &into result] (icollect [name (pairs (get-native-library library)) &into result]
name)) name))
(icollect [name (pairs (get-lua-version self.configuration.version)) &into result] (icollect [name (pairs (get-lua-version server.configuration.version)) &into result]
name))) name)))
(fn get-global [self global-name] (fn get-global [server global-name]
(or (or
(accumulate [result nil (accumulate [result nil
_ library (ipairs self.configuration.native-libraries) _ library (ipairs server.configuration.native-libraries)
&until result] &until result]
(. (get-native-library library) (. (get-native-library library)
global-name)) global-name))
(. (get-lua-version self.configuration.version) (. (get-lua-version server.configuration.version)
global-name))) global-name)))
(fn get-builtin [_self builtin-name] (fn get-builtin [_server builtin-name]
(or (. specials builtin-name) (or (. specials builtin-name)
(. macros* builtin-name))) (. macros* builtin-name)))

124
src/fennel-ls/handlers.fnl
View File

@ -17,10 +17,10 @@ Every time the client sends a message, it gets handled by a function in the corr
(local requests []) (local requests [])
(local notifications []) (local notifications [])
(λ requests.initialize [self send params] (λ requests.initialize [server send params]
(state.init-state self params) (state.init-state server params)
(let [capabilities (let [capabilities
{:positionEncoding self.position-encoding {:positionEncoding server.position-encoding
:textDocumentSync {:openClose true :change 2} :textDocumentSync {:openClose true :change 2}
;; :notebookDocumentSync nil ;; :notebookDocumentSync nil
:completionProvider {:workDoneProgress false :completionProvider {:workDoneProgress false
@ -68,48 +68,48 @@ Every time the client sends a message, it gets handled by a function in the corr
{: capabilities {: capabilities
:serverInfo {:name "fennel-ls" :version "0.1.0"}})) :serverInfo {:name "fennel-ls" :version "0.1.0"}}))
(λ requests.textDocument/definition [self send {: position :textDocument {: uri}}] (λ requests.textDocument/definition [server send {: position :textDocument {: uri}}]
(let [file (state.get-by-uri self uri) (let [file (state.get-by-uri server uri)
byte (utils.position->byte file.text position self.position-encoding)] byte (utils.position->byte file.text position server.position-encoding)]
(case-try (language.find-symbol file.ast byte) (case-try (language.find-symbol file.ast byte)
(symbol [parent]) (symbol [parent])
(if (if
;; require call ;; require call
(. file.require-calls parent) (. file.require-calls parent)
(language.search-ast self file parent [] {:stop-early? true}) (language.search-ast server file parent [] {:stop-early? true})
;; regular symbol ;; regular symbol
(language.search-main self file symbol {:stop-early? true} {: byte})) (language.search-main server file symbol {:stop-early? true} {: byte}))
result result
(if result.file (if result.file
(message.range-and-uri self result.file (or result.binding result.definition))) (message.range-and-uri server result.file (or result.binding result.definition)))
(catch _ nil)))) (catch _ nil))))
(λ requests.textDocument/references [self send {: position (λ requests.textDocument/references [server send {: position
:textDocument {: uri} :textDocument {: uri}
:context {:includeDeclaration ?include-declaration?}}] :context {:includeDeclaration ?include-declaration?}}]
(let [file (state.get-by-uri self uri) (let [file (state.get-by-uri server uri)
byte (utils.position->byte file.text position self.position-encoding)] byte (utils.position->byte file.text position server.position-encoding)]
(case-try (language.find-symbol file.ast byte) (case-try (language.find-symbol file.ast byte)
symbol symbol
(language.find-nearest-definition self file symbol byte) (language.find-nearest-definition server file symbol byte)
(where definition (not= definition.referenced-by nil)) (where definition (not= definition.referenced-by nil))
(let [result (icollect [_ {: symbol} (ipairs definition.referenced-by)] (let [result (icollect [_ {: symbol} (ipairs definition.referenced-by)]
(message.range-and-uri self definition.file symbol))] (message.range-and-uri server definition.file symbol))]
(if ?include-declaration? (if ?include-declaration?
(table.insert result (table.insert result
(message.range-and-uri self definition.file definition.binding))) (message.range-and-uri server definition.file definition.binding)))
;; TODO don't include duplicates ;; TODO don't include duplicates
result) result)
(catch _ nil)))) (catch _ nil))))
(λ requests.textDocument/hover [self send {: position :textDocument {: uri}}] (λ requests.textDocument/hover [server send {: position :textDocument {: uri}}]
(let [file (state.get-by-uri self uri) (let [file (state.get-by-uri server uri)
byte (utils.position->byte file.text position self.position-encoding)] byte (utils.position->byte file.text position server.position-encoding)]
(case-try (language.find-symbol file.ast byte) (case-try (language.find-symbol file.ast byte)
symbol (language.search-main self file symbol {} {: byte}) symbol (language.search-main server file symbol {} {: byte})
result {:contents (formatter.hover-format result) result {:contents (formatter.hover-format result)
:range (message.ast->range self file symbol)} :range (message.ast->range server file symbol)}
(catch _ nil)))) (catch _ nil))))
;; All of the helper functions for textDocument/completion are here until I ;; All of the helper functions for textDocument/completion are here until I
@ -130,12 +130,12 @@ Every time the client sends a message, it gets handled by a function in the corr
:Snippet 15 :Color 16 :File 17 :Reference 18 :Folder 19 :EnumMember 20 :Snippet 15 :Color 16 :File 17 :Reference 18 :Folder 19 :EnumMember 20
:Constant 21 :Struct 22 :Event 23 :Operator 24 :TypeParameter 25}) :Constant 21 :Struct 22 :Event 23 :Operator 24 :TypeParameter 25})
(λ make-completion-item [self file name scope] (λ make-completion-item [server file name scope]
(case (language.search-name-and-scope self file name scope) (case (language.search-name-and-scope server file name scope)
def (formatter.completion-item-format name def) def (formatter.completion-item-format name def)
_ {:label name})) _ {:label name}))
(λ scope-completion [self file byte ?symbol parents] (λ scope-completion [server file byte ?symbol parents]
(let [scope (or (accumulate [result nil (let [scope (or (accumulate [result nil
_ parent (ipairs parents) _ parent (ipairs parents)
&until result] &until result]
@ -145,24 +145,24 @@ Every time the client sends a message, it gets handled by a function in the corr
result [] result []
in-call-position? (and (fennel.list? ?parent) in-call-position? (and (fennel.list? ?parent)
(= ?symbol (. ?parent 1)))] (= ?symbol (. ?parent 1)))]
(collect-scope scope :manglings #(doto (make-completion-item self file $ scope) (tset :kind kinds.Variable)) result) (collect-scope scope :manglings #(doto (make-completion-item server file $ scope) (tset :kind kinds.Variable)) result)
(when in-call-position? (when in-call-position?
(collect-scope scope :macros #(doto (make-completion-item self file $ scope) (tset :kind kinds.Keyword)) result) (collect-scope scope :macros #(doto (make-completion-item server file $ scope) (tset :kind kinds.Keyword)) result)
(collect-scope scope :specials #(doto (make-completion-item self file $ scope) (tset :kind kinds.Operator)) result)) (collect-scope scope :specials #(doto (make-completion-item server file $ scope) (tset :kind kinds.Operator)) result))
(icollect [_ k (ipairs file.allowed-globals) &into result] (icollect [_ k (ipairs file.allowed-globals) &into result]
(make-completion-item self file k scope)))) (make-completion-item server file k scope))))
(λ field-completion [self file symbol split] (λ field-completion [server file symbol split]
(let [stack (fcollect [i (- (length split) 1) 2 -1] (let [stack (fcollect [i (- (length split) 1) 2 -1]
(. split i)) (. split i))
last-found-binding [] last-found-binding []
result (language.search-main self file symbol {:save-last-binding last-found-binding} {: stack})] result (language.search-main server file symbol {:save-last-binding last-found-binding} {: stack})]
(case result (case result
{: definition : file} {: definition : file}
(case (values definition (type definition)) (case (values definition (type definition))
;; fields of a string are hardcoded to "string" ;; fields of a string are hardcoded to "string"
(_str :string) (icollect [label info (pairs (. (docs.get-global self :string) :fields))] (_str :string) (icollect [label info (pairs (. (docs.get-global server :string) :fields))]
(formatter.completion-item-format label info)) (formatter.completion-item-format label info))
;; fields of a table ;; fields of a table
(tbl :table) (let [keys []] (tbl :table) (let [keys []]
@ -173,7 +173,7 @@ Every time the client sends a message, it gets handled by a function in the corr
label)) label))
(icollect [_ label (pairs keys)] (icollect [_ label (pairs keys)]
(if (= (type label) :string) (if (= (type label) :string)
(case (language.search-ast self file tbl [label] {}) (case (language.search-ast server file tbl [label] {})
def (formatter.completion-item-format label def) def (formatter.completion-item-format label def)
_ {: label :kind kinds.Field}))))) _ {: label :kind kinds.Field})))))
{: metadata : fields} {: metadata : fields}
@ -182,16 +182,16 @@ Every time the client sends a message, it gets handled by a function in the corr
(formatter.completion-item-format label info))) (formatter.completion-item-format label info)))
_ nil))) _ nil)))
(λ requests.textDocument/completion [self send {: position :textDocument {: uri}}] (λ requests.textDocument/completion [server send {: position :textDocument {: uri}}]
(let [file (state.get-by-uri self uri) (let [file (state.get-by-uri server uri)
byte (utils.position->byte file.text position self.position-encoding) byte (utils.position->byte file.text position server.position-encoding)
(?symbol parents) (language.find-symbol file.ast byte)] (?symbol parents) (language.find-symbol file.ast byte)]
(case (-?> ?symbol utils.multi-sym-split) (case (-?> ?symbol utils.multi-sym-split)
;; completion from current scope ;; completion from current scope
(where (or nil [_ nil])) (where (or nil [_ nil]))
(let [input-range (if ?symbol (message.multisym->range self file ?symbol -1) {:start position :end position}) (let [input-range (if ?symbol (message.multisym->range server file ?symbol -1) {:start position :end position})
?completions (scope-completion self file byte ?symbol parents)] ?completions (scope-completion server file byte ?symbol parents)]
(if ?completions (if ?completions
(let [?completions (utils.uniq-by ?completions #$.label)] (let [?completions (utils.uniq-by ?completions #$.label)]
(each [_ completion (ipairs ?completions)] (each [_ completion (ipairs ?completions)]
@ -200,10 +200,10 @@ Every time the client sends a message, it gets handled by a function in the corr
;; completion from field ;; completion from field
[_a _b &as split] [_a _b &as split]
(let [input-range (message.multisym->range self file ?symbol -1) (let [input-range (message.multisym->range server file ?symbol -1)
?completions (field-completion self file ?symbol split)] ?completions (field-completion server file ?symbol split)]
(if ?completions (if ?completions
(if self.EGLOT_COMPLETION_QUIRK_MODE (if server.EGLOT_COMPLETION_QUIRK_MODE
(let [prefix (string.gsub (tostring ?symbol) "[^.:]*$" "")] (let [prefix (string.gsub (tostring ?symbol) "[^.:]*$" "")]
(each [_ completion (ipairs ?completions)] (each [_ completion (ipairs ?completions)]
(set completion.filterText (.. prefix completion.label)) (set completion.filterText (.. prefix completion.label))
@ -214,21 +214,21 @@ Every time the client sends a message, it gets handled by a function in the corr
(λ requests.textDocument/rename [self send {: position :textDocument {: uri} :newName new-name}] (λ requests.textDocument/rename [server send {: position :textDocument {: uri} :newName new-name}]
(let [file (state.get-by-uri self uri) (let [file (state.get-by-uri server uri)
byte (utils.position->byte file.text position self.position-encoding)] byte (utils.position->byte file.text position server.position-encoding)]
(case-try (language.find-symbol file.ast byte) (case-try (language.find-symbol file.ast byte)
symbol symbol
(language.find-nearest-definition self file symbol symbol.bytestart) (language.find-nearest-definition server file symbol symbol.bytestart)
;; TODO we are assuming that every reference is in the same file ;; TODO we are assuming that every reference is in the same file
(where definition (not= definition.referenced-by nil)) (where definition (not= definition.referenced-by nil))
(let [usages (icollect [_ {: symbol} (ipairs definition.referenced-by) (let [usages (icollect [_ {: symbol} (ipairs definition.referenced-by)
&into [{:range (message.multisym->range self definition.file definition.binding 1) &into [{:range (message.multisym->range server definition.file definition.binding 1)
:newText new-name}]] :newText new-name}]]
(if (and (. file.lexical symbol) (if (and (. file.lexical symbol)
(not (rawequal symbol definition.binding))) (not (rawequal symbol definition.binding)))
{:newText new-name {:newText new-name
:range (message.multisym->range self definition.file symbol 1)}))] :range (message.multisym->range server definition.file symbol 1)}))]
;; NOTE: I don't care about encoding here because we just need the relative positions ;; NOTE: I don't care about encoding here because we just need the relative positions
(table.sort usages (table.sort usages
@ -252,45 +252,45 @@ Every time the client sends a message, it gets handled by a function in the corr
(and (pos<= range-1.start range-2.end) (and (pos<= range-1.start range-2.end)
(pos<= range-2.start range-1.end))) (pos<= range-2.start range-1.end)))
(λ requests.textDocument/codeAction [self send {: range :textDocument {: uri} &as params}] (λ requests.textDocument/codeAction [server send {: range :textDocument {: uri} &as params}]
(let [file (state.get-by-uri self uri)] (let [file (state.get-by-uri server uri)]
(icollect [_ diagnostic (ipairs file.diagnostics)] (icollect [_ diagnostic (ipairs file.diagnostics)]
(if (and (overlap? diagnostic.range range) (if (and (overlap? diagnostic.range range)
diagnostic.quickfix) diagnostic.quickfix)
{:title diagnostic.codeDescription {:title diagnostic.codeDescription
:edit {:changes {uri (diagnostic.quickfix)}}})))) :edit {:changes {uri (diagnostic.quickfix)}}}))))
(λ notifications.textDocument/didChange [self send {: contentChanges :textDocument {: uri}}] (λ notifications.textDocument/didChange [server send {: contentChanges :textDocument {: uri}}]
(local file (state.get-by-uri self uri)) (local file (state.get-by-uri server uri))
(state.set-uri-contents self uri (utils.apply-changes file.text contentChanges self.position-encoding)) (state.set-uri-contents server uri (utils.apply-changes file.text contentChanges server.position-encoding))
(lint.check self file) (lint.check server file)
(send (message.diagnostics file))) (send (message.diagnostics file)))
(λ notifications.textDocument/didOpen [self send {:textDocument {: languageId : text : uri}}] (λ notifications.textDocument/didOpen [server send {:textDocument {: languageId : text : uri}}]
(local file (state.set-uri-contents self uri text)) (local file (state.set-uri-contents server uri text))
(lint.check self file) (lint.check server file)
(send (message.diagnostics file)) (send (message.diagnostics file))
(set file.open? true)) (set file.open? true))
(λ notifications.textDocument/didSave [self send {:textDocument {: uri}}] (λ notifications.textDocument/didSave [server send {:textDocument {: uri}}]
;; TODO be careful about which modules need to be recomputed, and also eagerly flush existing files ;; TODO be careful about which modules need to be recomputed, and also eagerly flush existing files
(set fennel.macro-loaded [])) (set fennel.macro-loaded []))
(λ notifications.textDocument/didClose [self send {:textDocument {: uri}}] (λ notifications.textDocument/didClose [server send {:textDocument {: uri}}]
(local file (state.get-by-uri self uri)) (local file (state.get-by-uri server uri))
(set file.open? false) (set file.open? false)
(set fennel.macro-loaded []) (set fennel.macro-loaded [])
;; TODO only reload from disk if we didn't get a didSave, instead of always ;; TODO only reload from disk if we didn't get a didSave, instead of always
(state.flush-uri self uri)) (state.flush-uri server uri))
(λ notifications.workspace/didChangeConfiguration [self send {: settings}] (λ notifications.workspace/didChangeConfiguration [server send {: settings}]
(state.write-configuration self (?. settings :fennel-ls))) (state.write-configuration server (?. settings :fennel-ls)))
(λ requests.shutdown [self send] (λ requests.shutdown [server send]
"The server still needs to respond to this request, so the program can't close yet. Just wait until notifications.exit" "The server still needs to respond to this request, so the program can't close yet. Just wait until notifications.exit"
nil) nil)
(λ notifications.exit [self] (λ notifications.exit [server]
"This is the real shutdown request, we can quit now" "This is the real shutdown request, we can quit now"
(os.exit 0)) (os.exit 0))

80
src/fennel-ls/language.fnl
View File

@ -64,7 +64,7 @@ find the definition `10`, but if `opts.stop-early?` is set, it would find
"add the multisy values to the end of the stack in reverse order" "add the multisy values to the end of the stack in reverse order"
(stack-add-split! stack (utils.multi-sym-split symbol))) (stack-add-split! stack (utils.multi-sym-split symbol)))
(λ search-document [self document stack opts] (λ search-document [server document stack opts]
(when (and (not= (tostring (?. document :binding)) :_G) (when (and (not= (tostring (?. document :binding)) :_G)
(= (length stack) 1)) (= (length stack) 1))
(set opts.searched-through-require-with-stack-size-1 true)) (set opts.searched-through-require-with-stack-size-1 true))
@ -72,13 +72,13 @@ find the definition `10`, but if `opts.stop-early?` is set, it would find
document document
(and document.fields (and document.fields
(. document.fields (. stack (length stack)))) (. document.fields (. stack (length stack))))
(search-document self (. document.fields (table.remove stack)) stack opts))) (search-document server (. document.fields (table.remove stack)) stack opts)))
(λ search-val [self file ?ast stack opts] (λ search-val [server file ?ast stack opts]
"searches for the definition of the ast, adjusted to 1 value" "searches for the definition of the ast, adjusted to 1 value"
(search-multival self file ?ast stack 1 opts)) (search-multival server file ?ast stack 1 opts))
(λ search-assignment [self file assignment stack opts] (λ search-assignment [server file assignment stack opts]
(let [{:target {:binding _ (let [{:target {:binding _
:definition ?definition :definition ?definition
:keys ?keys :keys ?keys
@ -91,56 +91,56 @@ find the definition `10`, but if `opts.stop-early?` is set, it would find
assignment.target ;; BASE CASE!! assignment.target ;; BASE CASE!!
;; search a virtual field from :fields ;; search a virtual field from :fields
(and (not= 0 (length stack)) (?. ?fields (. stack (length stack)))) (and (not= 0 (length stack)) (?. ?fields (. stack (length stack))))
(search-assignment self file {:target (. ?fields (table.remove stack))} stack opts) (search-assignment server file {:target (. ?fields (table.remove stack))} stack opts)
(search-multival self file ?definition (stack-add-keys! stack ?keys) (or ?multival 1) opts)))) (search-multival server file ?definition (stack-add-keys! stack ?keys) (or ?multival 1) opts))))
(λ search-reference [self file ref stack opts] (λ search-reference [server file ref stack opts]
(if ref.target.metadata (if ref.target.metadata
(search-document self ref.target stack opts) (search-document server ref.target stack opts)
ref.target.binding ref.target.binding
(search-assignment self file ref stack opts))) (search-assignment server file ref stack opts)))
(λ search-symbol [self file symbol stack opts] (λ search-symbol [server file symbol stack opts]
(if (= (tostring symbol) :nil) (if (= (tostring symbol) :nil)
(if (= 0 (length stack)) (if (= 0 (length stack))
{:definition symbol : file} {:definition symbol : file}
nil) nil)
(if (. file.references symbol) (if (. file.references symbol)
(search-reference self file (. file.references symbol) (stack-add-multisym! stack symbol) opts)))) (search-reference server file (. file.references symbol) (stack-add-multisym! stack symbol) opts))))
(λ search-table [self file tbl stack opts] (λ search-table [server file tbl stack opts]
(if (. tbl (. stack (length stack))) (if (. tbl (. stack (length stack)))
(search-val self file (. tbl (table.remove stack)) stack opts) (search-val server file (. tbl (table.remove stack)) stack opts)
nil)) ;; BASE CASE Give up nil)) ;; BASE CASE Give up
(λ search-list [self file call stack multival opts] (λ search-list [server file call stack multival opts]
(let [head (. call 1)] (let [head (. call 1)]
(if (sym? head) (if (sym? head)
(case (tostring head) (case (tostring head)
(where (or :do :let)) (where (or :do :let))
(search-multival self file (. call (length call)) stack multival opts) (search-multival server file (. call (length call)) stack multival opts)
:values :values
(let [len (- (length call) 1)] (let [len (- (length call) 1)]
(if (< multival len) (if (< multival len)
(search-val self file (. call (+ 1 multival)) stack opts) (search-val server file (. call (+ 1 multival)) stack opts)
(search-multival self file (. call (+ len 1)) stack (+ multival (- len) 1) opts))) (search-multival server file (. call (+ len 1)) stack (+ multival (- len) 1) opts)))
(where (or :require :include)) (where (or :require :include))
(let [mod (. call 2)] (let [mod (. call 2)]
(if (= multival 1) (if (= multival 1)
(when (= :string (type mod)) (when (= :string (type mod))
(let [newfile (state.get-by-module self mod)] (let [newfile (state.get-by-module server mod)]
(when newfile (when newfile
(let [newitem (. newfile.ast (length newfile.ast))] (let [newitem (. newfile.ast (length newfile.ast))]
(when (= (length stack) 1) (when (= (length stack) 1)
(set opts.searched-through-require-with-stack-size-1 true)) (set opts.searched-through-require-with-stack-size-1 true))
(search-val self newfile newitem stack opts))))))) (search-val server newfile newitem stack opts)))))))
"." "."
(if (= multival 1) (if (= multival 1)
(let [[_ & rest] call] (let [[_ & rest] call]
(search-val self file (. call 2) (stack-add-split! stack rest) opts))) (search-val server file (. call 2) (stack-add-split! stack rest) opts)))
;; TODO assume-function-name analyze-metatable ;; TODO assume-function-name analyze-metatable
:setmetatable :setmetatable
(search-val self file (. call 2) stack opts) (search-val server file (. call 2) stack opts)
(where (or :fn :lambda :λ)) (where (or :fn :lambda :λ))
(if (and (= multival 1) (= 0 (length stack))) (if (and (= multival 1) (= 0 (length stack)))
@ -152,20 +152,20 @@ find the definition `10`, but if `opts.stop-early?` is set, it would find
{:definition call : file}))))) ;; BASE CASE!! {:definition call : file}))))) ;; BASE CASE!!
(set search-multival (set search-multival
(λ [self file ?ast stack multival opts] (λ [server file ?ast stack multival opts]
(let [ast ?ast] ;; it was a bad idea to use λ because ast may be nil (let [ast ?ast] ;; it was a bad idea to use λ because ast may be nil
(if (list? ast) (search-list self file ast stack multival opts) (if (list? ast) (search-list server file ast stack multival opts)
(varg? ast) nil ;; TODO function-args (varg? ast) nil ;; TODO function-args
(= 1 multival) (= 1 multival)
(if (sym? ast) (search-symbol self file ast stack opts) (if (sym? ast) (search-symbol server file ast stack opts)
(= 0 (length stack)) {:definition ast : file} ;; BASE CASE !! (= 0 (length stack)) {:definition ast : file} ;; BASE CASE !!
(= :table (type ast)) (search-table self file ast stack opts) (= :table (type ast)) (search-table server file ast stack opts)
(= :string (type ast)) (search-document self (docs.get-global self :string) stack opts)) (= :string (type ast)) (search-document server (docs.get-global server :string) stack opts))
nil)))) nil))))
;; the options thing is getting out of hand ;; the options thing is getting out of hand
(λ search-main [self file symbol opts initialization-opts] (λ search-main [server file symbol opts initialization-opts]
"Find the definition of a symbol" "Find the definition of a symbol"
(assert (= (type initialization-opts) :table)) (assert (= (type initialization-opts) :table))
@ -179,12 +179,12 @@ find the definition `10`, but if `opts.stop-early?` is set, it would find
(let [?byte initialization-opts.byte (let [?byte initialization-opts.byte
split (utils.multi-sym-split symbol (if ?byte (- ?byte symbol.bytestart)))] split (utils.multi-sym-split symbol (if ?byte (- ?byte symbol.bytestart)))]
(stack-add-split! [] split)))] (stack-add-split! [] split)))]
(case (docs.get-builtin self (utils.multi-sym-base symbol)) (case (docs.get-builtin server (utils.multi-sym-base symbol))
document (search-document self document stack opts) document (search-document server document stack opts)
_ (case (. file.references symbol) _ (case (. file.references symbol)
ref (search-reference self file ref stack opts) ref (search-reference server file ref stack opts)
_ (case (. file.definitions symbol) _ (case (. file.definitions symbol)
def (search-multival self file def.definition (stack-add-keys! stack def.keys) (or def.multival 1) opts))))))) def (search-multival server file def.definition (stack-add-keys! stack def.keys) (or def.multival 1) opts)))))))
(λ find-local-definition [file name ?scope] (λ find-local-definition [file name ?scope]
(when ?scope (when ?scope
@ -192,18 +192,18 @@ find the definition `10`, but if `opts.stop-early?` is set, it would find
definition definition definition definition
_ (find-local-definition file name ?scope.parent)))) _ (find-local-definition file name ?scope.parent))))
(λ search-name-and-scope [self file name scope ?opts] (λ search-name-and-scope [server file name scope ?opts]
"find a definition just from the name of the item, and the scope it is in" "find a definition just from the name of the item, and the scope it is in"
(assert (= (type name) :string)) (assert (= (type name) :string))
(let [split (utils.multi-sym-split name) (let [split (utils.multi-sym-split name)
stack (stack-add-split! [] split) stack (stack-add-split! [] split)
opts (or ?opts {})] opts (or ?opts {})]
(case (docs.get-builtin self (. split 1)) (case (docs.get-builtin server (. split 1))
metadata (search-document self metadata stack opts) metadata (search-document server metadata stack opts)
_ (case (docs.get-global self (. split 1)) _ (case (docs.get-global server (. split 1))
metadata (search-document self metadata stack opts) metadata (search-document server metadata stack opts)
_ (case (find-local-definition file name scope) _ (case (find-local-definition file name scope)
def (search-val self file def.definition (stack-add-keys! stack def.keys) opts)))))) def (search-val server file def.definition (stack-add-keys! stack def.keys) opts))))))
(λ _past? [?ast byte] (λ _past? [?ast byte]
;; check if a byte is past an ast object ;; check if a byte is past an ast object
@ -262,10 +262,10 @@ find the definition `10`, but if `opts.stop-early?` is set, it would find
(fcollect [i 1 (length parents)] (fcollect [i 1 (length parents)]
(. parents (- (length parents) i -1))))) (. parents (- (length parents) i -1)))))
(λ find-nearest-definition [self file symbol ?byte] (λ find-nearest-definition [server file symbol ?byte]
(if (. file.definitions symbol) (if (. file.definitions symbol)
(. file.definitions symbol) (. file.definitions symbol)
(search-main self file symbol {:stop-early? true} {:byte ?byte}))) (search-main server file symbol {:stop-early? true} {:byte ?byte})))
{: find-symbol {: find-symbol
: find-nearest-definition : find-nearest-definition

58
src/fennel-ls/lint.fnl
View File

@ -1,5 +1,5 @@
"Diagnostics "Diagnostics
Provides the function (check self file), which goes through a file and mutates Provides the function (check server file), which goes through a file and mutates
the `file.diagnostics` field, filling it with diagnostics." the `file.diagnostics` field, filling it with diagnostics."
(local {: sym? : list? : view} (require :fennel)) (local {: sym? : list? : view} (require :fennel))
@ -10,8 +10,8 @@ the `file.diagnostics` field, filling it with diagnostics."
(require :fennel.compiler)) (require :fennel.compiler))
(local diagnostic-mt {:__json_exclude_keys {:quickfix true}}) (local diagnostic-mt {:__json_exclude_keys {:quickfix true}})
(fn diagnostic [self] (fn diagnostic [server]
(setmetatable self diagnostic-mt)) (setmetatable server diagnostic-mt))
(local ops {"+" 1 "-" 1 "*" 1 "/" 1 "//" 1 "%" 1 "^" 1 ">" 1 "<" 1 ">=" 1 "<=" 1 "=" 1 "not=" 1 ".." 1 "." 1 "and" 1 "or" 1 "band" 1 "bor" 1 "bxor" 1 "bnot" 1 "lshift" 1 "rshift" 1}) (local ops {"+" 1 "-" 1 "*" 1 "/" 1 "//" 1 "%" 1 "^" 1 ">" 1 "<" 1 ">=" 1 "<=" 1 "=" 1 "not=" 1 ".." 1 "." 1 "and" 1 "or" 1 "band" 1 "bor" 1 "bxor" 1 "bnot" 1 "lshift" 1 "rshift" 1})
(fn special? [item] (fn special? [item]
@ -24,7 +24,7 @@ the `file.diagnostics` field, filling it with diagnostics."
(. ops (tostring item)) (. ops (tostring item))
item)) item))
(λ unused-definition [self file symbol definition] (λ unused-definition [server file symbol definition]
"local variable that is defined but not used" "local variable that is defined but not used"
(if (not (or (= "_" (: (tostring symbol) :sub 1 1)) (if (not (or (= "_" (: (tostring symbol) :sub 1 1))
(accumulate [reference false (accumulate [reference false
@ -33,7 +33,7 @@ the `file.diagnostics` field, filling it with diagnostics."
(or (= ref.ref-type :read) (or (= ref.ref-type :read)
(= ref.ref-type :mutate))))) (= ref.ref-type :mutate)))))
(diagnostic (diagnostic
{:range (message.ast->range self file symbol) {:range (message.ast->range server file symbol)
:message (.. "unused definition: " (tostring symbol)) :message (.. "unused definition: " (tostring symbol))
:severity message.severity.WARN :severity message.severity.WARN
:code 301 :code 301
@ -41,20 +41,20 @@ the `file.diagnostics` field, filling it with diagnostics."
:quickfix #[{:range (message.ast->range symbol) :quickfix #[{:range (message.ast->range symbol)
:newText (.. "_" (tostring symbol))}]}))) :newText (.. "_" (tostring symbol))}]})))
(λ unknown-module-field [self file] (λ unknown-module-field [server file]
"any multisym whose definition can't be found through a (require) call" "any multisym whose definition can't be found through a (require) call"
(icollect [symbol (pairs file.references) &into file.diagnostics] (icollect [symbol (pairs file.references) &into file.diagnostics]
(if (. (utils.multi-sym-split symbol) 2) (if (. (utils.multi-sym-split symbol) 2)
(let [opts {} (let [opts {}
item (language.search-ast self file symbol [] opts)] item (language.search-ast server file symbol [] opts)]
(if (and (not item) opts.searched-through-require-with-stack-size-1) (if (and (not item) opts.searched-through-require-with-stack-size-1)
{:range (message.ast->range self file symbol) {:range (message.ast->range server file symbol)
:message (.. "unknown field: " (tostring symbol)) :message (.. "unknown field: " (tostring symbol))
:severity message.severity.WARN :severity message.severity.WARN
:code 302 :code 302
:codeDescription "unknown-module-field"}))))) :codeDescription "unknown-module-field"})))))
(λ unnecessary-method [self file colon call] (λ unnecessary-method [server file colon call]
"a call to the : builtin that could just be a multisym" "a call to the : builtin that could just be a multisym"
(if (and (sym? colon ":") (if (and (sym? colon ":")
(sym? (. call 2)) (sym? (. call 2))
@ -63,13 +63,13 @@ the `file.diagnostics` field, filling it with diagnostics."
(if (and (= :string (type method)) (if (and (= :string (type method))
(not (method:find "^[0-9]")) (not (method:find "^[0-9]"))
(not (method:find "[^!$%*+-/0-9<=>?A-Z\\^_a-z|\128-\255]"))) (not (method:find "[^!$%*+-/0-9<=>?A-Z\\^_a-z|\128-\255]")))
{:range (message.ast->range self file call) {:range (message.ast->range server file call)
:message (.. "unnecessary : call: use (" (tostring (. call 2)) ":" method ")") :message (.. "unnecessary : call: use (" (tostring (. call 2)) ":" method ")")
:severity message.severity.WARN :severity message.severity.WARN
:code 303 :code 303
:codeDescription "unnecessary-method"})))) :codeDescription "unnecessary-method"}))))
(λ bad-unpack [self file op call] (λ bad-unpack [server file op call]
"an unpack call leading into an operator" "an unpack call leading into an operator"
(let [last-item (. call (length call))] (let [last-item (. call (length call))]
(if (and (op? op) (if (and (op? op)
@ -81,7 +81,7 @@ the `file.diagnostics` field, filling it with diagnostics."
(. file.lexical last-item) (. file.lexical last-item)
(. file.lexical call)) (. file.lexical call))
(diagnostic (diagnostic
{:range (message.ast->range self file last-item) {:range (message.ast->range server file last-item)
:message (.. "faulty unpack call: " (tostring op) " isn't variadic at runtime." :message (.. "faulty unpack call: " (tostring op) " isn't variadic at runtime."
(if (sym? op "..") (if (sym? op "..")
(let [unpackme (view (. last-item 2))] (let [unpackme (view (. last-item 2))]
@ -93,19 +93,19 @@ the `file.diagnostics` field, filling it with diagnostics."
:quickfix (if (and (= (length call) 2) :quickfix (if (and (= (length call) 2)
(= (length (. call 2)) 2) (= (length (. call 2)) 2)
(sym? op "..")) (sym? op ".."))
#[{:range (message.ast->range self file call) #[{:range (message.ast->range server file call)
:newText (.. "(table.concat " (view (. call 2 2)) ")")}])})))) :newText (.. "(table.concat " (view (. call 2 2)) ")")}])}))))
(λ var-never-set [self file symbol definition] (λ var-never-set [server file symbol definition]
(if (and definition.var? (not definition.var-set) (. file.lexical symbol)) (if (and definition.var? (not definition.var-set) (. file.lexical symbol))
{:range (message.ast->range self file symbol) {:range (message.ast->range server file symbol)
:message (.. "var is never set: " (tostring symbol) " Consider using (local) instead of (var)") :message (.. "var is never set: " (tostring symbol) " Consider using (local) instead of (var)")
:severity message.severity.WARN :severity message.severity.WARN
:code 305 :code 305
:codeDescription "var-never-set"})) :codeDescription "var-never-set"}))
(local op-identity-value {:+ 0 :* 1 :and true :or false :band -1 :bor 0 :.. ""}) (local op-identity-value {:+ 0 :* 1 :and true :or false :band -1 :bor 0 :.. ""})
(λ op-with-no-arguments [self file op call] (λ op-with-no-arguments [server file op call]
"A call like (+) that could be replaced with a literal" "A call like (+) that could be replaced with a literal"
(let [identity (. op-identity-value (tostring op))] (let [identity (. op-identity-value (tostring op))]
(if (and (op? op) (if (and (op? op)
@ -113,15 +113,15 @@ the `file.diagnostics` field, filling it with diagnostics."
(. file.lexical call) (. file.lexical call)
(not= nil identity)) (not= nil identity))
(diagnostic (diagnostic
{:range (message.ast->range self file call) {:range (message.ast->range server file call)
:message (.. "write " (view identity) " instead of (" (tostring op) ")") :message (.. "write " (view identity) " instead of (" (tostring op) ")")
:severity message.severity.WARN :severity message.severity.WARN
:code 306 :code 306
:codeDescription "op-with-no-arguments" :codeDescription "op-with-no-arguments"
:quickfix #[{:range (message.ast->range self file call) :quickfix #[{:range (message.ast->range server file call)
:newText (view identity)}]})))) :newText (view identity)}]}))))
(λ multival-in-middle-of-call [self file fun call arg index] (λ multival-in-middle-of-call [server file fun call arg index]
"generally, values and unpack are signs that the user is trying to do "generally, values and unpack are signs that the user is trying to do
something with multiple values. However, multiple values will get something with multiple values. However, multiple values will get
\"adjusted\" to one value if they don't come at the end of the call." \"adjusted\" to one value if they don't come at the end of the call."
@ -132,29 +132,29 @@ the `file.diagnostics` field, filling it with diagnostics."
(sym? (. arg 1) :unpack) (sym? (. arg 1) :unpack)
(sym? (. arg 1) :_G.unpack) (sym? (. arg 1) :_G.unpack)
(sym? (. arg 1) :table.unpack))) (sym? (. arg 1) :table.unpack)))
{:range (message.ast->range self file arg) {:range (message.ast->range server file arg)
:message (.. "bad " (tostring (. arg 1)) " call: only the first value of the multival will be used") :message (.. "bad " (tostring (. arg 1)) " call: only the first value of the multival will be used")
:severity message.severity.WARN :severity message.severity.WARN
:code 307 :code 307
:codeDescription "bad-unpack"})) :codeDescription "bad-unpack"}))
(λ check [self file] (λ check [server file]
"fill up the file.diagnostics table with linting things" "fill up the file.diagnostics table with linting things"
(let [checks self.configuration.checks (let [checks server.configuration.checks
diagnostics file.diagnostics] diagnostics file.diagnostics]
;; definition lints ;; definition lints
(each [symbol definition (pairs file.definitions)] (each [symbol definition (pairs file.definitions)]
(if checks.unused-definition (table.insert diagnostics (unused-definition self file symbol definition))) (if checks.unused-definition (table.insert diagnostics (unused-definition server file symbol definition)))
(if checks.var-never-set (table.insert diagnostics (var-never-set self file symbol definition)))) (if checks.var-never-set (table.insert diagnostics (var-never-set server file symbol definition))))
;; call lints ;; call lints
;; all non-macro calls. This only covers specials and function calls. ;; all non-macro calls. This only covers specials and function calls.
(each [[head &as call] (pairs file.calls)] (each [[head &as call] (pairs file.calls)]
(when head (when head
(if checks.bad-unpack (table.insert diagnostics (bad-unpack self file head call))) (if checks.bad-unpack (table.insert diagnostics (bad-unpack server file head call)))
(if checks.unnecessary-method (table.insert diagnostics (unnecessary-method self file head call))) (if checks.unnecessary-method (table.insert diagnostics (unnecessary-method server file head call)))
(if checks.op-with-no-arguments (table.insert diagnostics (op-with-no-arguments self file head call))) (if checks.op-with-no-arguments (table.insert diagnostics (op-with-no-arguments server file head call)))
;; argument lints ;; argument lints
;; every argument to a special or a function call ;; every argument to a special or a function call
@ -162,10 +162,10 @@ the `file.diagnostics` field, filling it with diagnostics."
;; I'll wait till we have more lints in here to see if it needs to change. ;; I'll wait till we have more lints in here to see if it needs to change.
(for [index 2 (length call)] (for [index 2 (length call)]
(let [arg (. call index)] (let [arg (. call index)]
(if checks.multival-in-middle-of-call (table.insert diagnostics (multival-in-middle-of-call self file head call arg index))))))) (if checks.multival-in-middle-of-call (table.insert diagnostics (multival-in-middle-of-call server file head call arg index)))))))
(if checks.unknown-module-field (if checks.unknown-module-field
(unknown-module-field self file)))) (unknown-module-field server file))))
;; (if checks.unnecessary-values ;; (if checks.unnecessary-values
;; (unnecessary-values file))) ;; (unnecessary-values file)))
;; (if checks.unnecessary-do) ;; (if checks.unnecessary-do)

16
src/fennel-ls/message.fnl
View File

@ -58,14 +58,14 @@ LSP json objects."
: id : id
:result (nullify ?result)}) :result (nullify ?result)})
(λ ast->range [self file ?ast] (λ ast->range [server file ?ast]
(case (fennel.ast-source ?ast) (case (fennel.ast-source ?ast)
{: bytestart : byteend} {:start (utils.byte->position file.text bytestart {: bytestart : byteend} {:start (utils.byte->position file.text bytestart
self.position-encoding) server.position-encoding)
:end (utils.byte->position file.text (+ byteend 1) :end (utils.byte->position file.text (+ byteend 1)
self.position-encoding)})) server.position-encoding)}))
(λ multisym->range [self file ast n] (λ multisym->range [server file ast n]
(let [spl (utils.multi-sym-split ast) (let [spl (utils.multi-sym-split ast)
n (if (< n 0) (+ n 1 (length spl)) n)] n (if (< n 0) (+ n 1 (length spl)) n)]
(case (values (utils.get-ast-info ast :bytestart) (case (values (utils.get-ast-info ast :bytestart)
@ -77,12 +77,12 @@ LSP json objects."
bytesubend (faccumulate [b byteend bytesubend (faccumulate [b byteend
i (+ n 1) (length spl)] i (+ n 1) (length spl)]
(- b (length (. spl i)) 1))] (- b (length (. spl i)) 1))]
{:start (utils.byte->position file.text bytesubstart self.position-encoding) {:start (utils.byte->position file.text bytesubstart server.position-encoding)
:end (utils.byte->position file.text (+ bytesubend 1) self.position-encoding)})))) :end (utils.byte->position file.text (+ bytesubend 1) server.position-encoding)}))))
(λ range-and-uri [self {: uri &as file} ?ast] (λ range-and-uri [server {: uri &as file} ?ast]
"if possible, returns the location of a symbol" "if possible, returns the location of a symbol"
(case (ast->range self file ?ast) (case (ast->range server file ?ast)
range {: range : uri})) range {: range : uri}))
(λ diagnostics [file] (λ diagnostics [file]

8
src/fennel-ls/searcher.fnl
View File

@ -37,12 +37,12 @@ I suspect this file may be gone after a bit of refactoring."
(table.insert result (join (utils.uri->path workspace) path))))) (table.insert result (join (utils.uri->path workspace) path)))))
(table.concat result ";"))) (table.concat result ";")))
(fn file-exists? [self uri] (fn file-exists? [server uri]
(or (. self.preload uri) (or (. server.preload uri)
(case (io.open (utils.uri->path uri)) (case (io.open (utils.uri->path uri))
f (do (f:close) true)))) f (do (f:close) true))))
(λ lookup [{:configuration {: fennel-path} :root-uri ?root-uri &as self} mod] (λ lookup [{:configuration {: fennel-path} :root-uri ?root-uri &as server} mod]
"Use the fennel path to find a file on disk" "Use the fennel path to find a file on disk"
(when ?root-uri (when ?root-uri
(let [mod (mod:gsub "%." sep) (let [mod (mod:gsub "%." sep)
@ -55,7 +55,7 @@ I suspect this file may be gone after a bit of refactoring."
segment segment
(join root-path segment)) (join root-path segment))
segment (utils.path->uri segment)] segment (utils.path->uri segment)]
(if (file-exists? self segment) (if (file-exists? server segment)
segment)))))) segment))))))
{: lookup {: lookup

67
src/fennel-ls/state.fnl
View File

@ -4,15 +4,14 @@ This module keeps track of the state of the language server:
* Loaded files * Loaded files
There is no global state in this project: all state is stored There is no global state in this project: all state is stored
in the \"self\" object. Pretty much every \"self\" in the in the \"server\" object."
entire fennel-ls project is referring to the same object."
(local searcher (require :fennel-ls.searcher)) (local searcher (require :fennel-ls.searcher))
(local utils (require :fennel-ls.utils)) (local utils (require :fennel-ls.utils))
(local {: compile} (require :fennel-ls.compiler)) (local {: compile} (require :fennel-ls.compiler))
(λ read-file [self uri] (λ read-file [server uri]
(let [text (case (. self.preload uri) (let [text (case (. server.preload uri)
preload preload preload preload
_ (let [file (io.open (utils.uri->path uri))] _ (let [file (io.open (utils.uri->path uri))]
(if file (if file
@ -22,48 +21,48 @@ entire fennel-ls project is referring to the same object."
(error (.. "failed to open file" uri)))))] (error (.. "failed to open file" uri)))))]
{: uri : text})) {: uri : text}))
(λ get-by-uri [self uri] (λ get-by-uri [server uri]
(or (. self.files uri) (or (. server.files uri)
(let [file (read-file self uri)] (let [file (read-file server uri)]
(compile self file) (compile server file)
(tset self.files uri file) (tset server.files uri file)
file))) file)))
(λ get-by-module [self module] (λ get-by-module [server module]
;; check the cache ;; check the cache
(case (. self.modules module) (case (. server.modules module)
uri uri
(or (get-by-uri self uri) (or (get-by-uri server uri)
;; if the cached uri isn't found, clear the cache and try again ;; if the cached uri isn't found, clear the cache and try again
(do (tset self.modules module nil) (do (tset server.modules module nil)
(get-by-module self module))) (get-by-module server module)))
nil nil
(case (searcher.lookup self module) (case (searcher.lookup server module)
uri uri
(do (do
(tset self.modules module uri) (tset server.modules module uri)
(get-by-uri self uri))))) (get-by-uri server uri)))))
(λ set-uri-contents [self uri text] (λ set-uri-contents [server uri text]
(case (. self.files uri) (case (. server.files uri)
;; modify existing file ;; modify existing file
file file
(do (do
(when (not= text file.text) (when (not= text file.text)
(set file.text text) (set file.text text)
(compile self file)) (compile server file))
file) file)
;; create new file ;; create new file
nil nil
(let [file {: uri : text}] (let [file {: uri : text}]
(tset self.files uri file) (tset server.files uri file)
(compile self file) (compile server file)
file))) file)))
(λ flush-uri [self uri] (λ flush-uri [server uri]
"get rid of data about a file, in case it changed in some way" "get rid of data about a file, in case it changed in some way"
(tset self.files uri nil)) (tset server.files uri nil))
;; TODO: set the warning levels of lints ;; TODO: set the warning levels of lints
;; allow all globals ;; allow all globals
@ -127,20 +126,20 @@ However, when not an option, fennel-ls will fall back to positionEncoding=\"utf-
:utf-8 :utf-8
:utf-16))) :utf-16)))
(λ init-state [self params] (λ init-state [server params]
(set self.files {}) (set server.files {})
(set self.preload {}) (set server.preload {})
(set self.modules {}) (set server.modules {})
(set self.root-uri params.rootUri) (set server.root-uri params.rootUri)
(set self.position-encoding (choose-position-encoding params)) (set server.position-encoding (choose-position-encoding params))
(set self.configuration (make-configuration (?. params :initializationOptions :fennel-ls))) (set server.configuration (make-configuration (?. params :initializationOptions :fennel-ls)))
;; Eglot does completions differently than every other client I've seen so far, in that it considers foo.bar to be one "symbol". ;; Eglot does completions differently than every other client I've seen so far, in that it considers foo.bar to be one "symbol".
;; If the user types `foo.b`, every other client accepts `bar` as a completion, bun eglot wants the full `foo.bar` multisym. ;; If the user types `foo.b`, every other client accepts `bar` as a completion, bun eglot wants the full `foo.bar` multisym.
(set self.EGLOT_COMPLETION_QUIRK_MODE (= (?. params :clientInfo :name) :Eglot))) (set server.EGLOT_COMPLETION_QUIRK_MODE (= (?. params :clientInfo :name) :Eglot)))
(λ write-configuration [self ?configuration] (λ write-configuration [server ?configuration]
"This is where we can put anything that needs to react to config changes" "This is where we can put anything that needs to react to config changes"
(set self.configuration (make-configuration ?configuration))) (set server.configuration (make-configuration ?configuration)))
{: flush-uri {: flush-uri
: get-by-module : get-by-module