This commit is contained in:
XeroOl 2022-08-19 09:43:58 -05:00
parent 22b4235073
commit a09035dabc
No known key found for this signature in database
GPG Key ID: 9DD4B4B4DAED0322
15 changed files with 283 additions and 187 deletions

View File

@ -1,24 +1,25 @@
(local fennel (require :fennel))
(local {: sym? : list? : sequence? : sym : view &as fennel} (require :fennel))
(local message (require :fennel-ls.message))
;; words surrounded by - are symbols,
;; because fennel doesn't allow 'require in a runtime file
(local -require- (fennel.sym :require))
(local -fn- (fennel.sym :fn))
(local -λ- (fennel.sym :λ))
(local -lambda- (fennel.sym :lambda))
(local -require- (sym :require))
(local -fn- (sym :fn))
(local -λ- (sym :λ))
(local -lambda- (sym :lambda))
(λ multisym? [t]
;; check if t is a symbol with multiple parts, eg. foo.bar.baz
(and (fennel.sym? t)
(and (sym? t)
(let [t (tostring t)]
(or (t:find "%.")
(t:find ":")))))
(λ iter [t]
;; iterate through a list, sequence, or table
(if (or (fennel.list? t)
(fennel.sequence? t))
(if (or (list? t)
(sequence? t))
(ipairs t)
(pairs t)))
@ -31,109 +32,136 @@
(λ compile [file]
"Compile the file, and record all the useful information from the compiler into the file object"
(let [definitions-by-scope (doto {} (setmetatable has-tables-mt))
definitions {}
diagnostics {}
references {}
require-calls {}]
(local references {})
(local definitions-by-scope (doto {} (setmetatable has-tables-mt)))
(local definitions {})
(λ find-definition [name ?scope]
(when ?scope
(or (. definitions-by-scope ?scope name)
(find-definition name ?scope.parent))))
(λ find-definition [name ?scope]
(when ?scope
(or (. definitions-by-scope ?scope name)
(find-definition name ?scope.parent))))
(λ reference [ast scope]
;; Add a reference to the references
(assert (sym? ast))
;; find reference
(let [name (string.match (tostring ast) "[^%.:]+")
target (find-definition (tostring name) scope)]
(tset references ast target)))
(λ reference [ast scope]
;; Add a reference to the references
(assert (fennel.sym? ast))
;; find reference
(let [name (string.match (tostring ast) "[^%.:]+")
target (find-definition (tostring name) scope)]
(tset references ast target)))
(λ define [?definition binding scope]
;; Add a definition to the definitions
;; recursively explore the binding (which, in the general case, is a destructuring assignment)
;; right now I'm not keeping track of *how* the symbol was destructured: just finding all the symbols for now.
;; also, there's no logic for (values)
(λ recurse [binding keys]
(if (sym? binding)
(let [definition
{: binding
: ?definition
:?keys (if (not= 0 (length keys))
(fcollect [i 1 (length keys)]
(. keys i)))}]
(tset (. definitions-by-scope scope) (tostring binding) definition)
(tset definitions binding definition))
(= :table (type binding))
(each [k v (iter binding)]
(table.insert keys k)
(recurse v keys)
(table.remove keys))))
(recurse binding []))
(λ define [?definition binding scope]
;; Add a definition to the definitions
;; recursively explore the binding (which, in the general case, is a destructuring assignment)
;; right now I'm not keeping track of *how* the symbol was destructured: just finding all the symbols for now.
;; also, there's no logic for (values)
(λ recurse [binding keys]
(if (fennel.sym? binding)
(let [definition
{: binding
: ?definition
:?keys (if (not= 0 (length keys))
(fcollect [i 1 (length keys)]
(. keys i)))}]
(tset (. definitions-by-scope scope) (tostring binding) definition)
(tset definitions binding definition))
(= :table (type binding))
(each [k v (iter binding)]
(table.insert keys k)
(recurse v keys)
(table.remove keys))))
(recurse binding []))
(λ define-function-name [ast scope]
;; add a function definition to the definitions
(match ast
(where [_fn name args]
(and (fennel.sym? name)
(not (multisym? name)) ;; not dealing with multisym for now
(fennel.sequence? args)))
(tset (. definitions-by-scope scope) ;; !!! TODO somehow insert into child scope
(tostring name)
{:binding name
:?definition ast})))
(λ define-function-args [ast scope]
;; add the definitions of function arguments to the definitions
(local args
(λ define-function-name [ast scope]
;; add a function definition to the definitions
(match ast
(where [_fn args] (fennel.sequence? args)) args
(where [_fn _name args] (fennel.sequence? args)) args))
(each [_ argument (ipairs args)]
(define nil argument scope))) ;; we say function arguments are set to nil ;; !!! parent or child?
(where [_fn name args]
(and (sym? name)
(not (multisym? name)) ;; not dealing with multisym for now
(sequence? args)))
(tset (. definitions-by-scope scope) ;; !!! TODO somehow insert into child scope
(tostring name)
{:binding name
:?definition ast})))
(λ define-function [ast scope]
;; handle the definitions of a function
(define-function-name ast scope)
(define-function-args ast scope))
(λ define-function-args [ast scope]
;; add the definitions of function arguments to the definitions
(local args
(match ast
(where [_fn args] (fennel.sequence? args)) args
(where [_fn _name args] (fennel.sequence? args)) args))
(each [_ argument (ipairs args)]
(define nil argument scope))) ;; we say function arguments are set to nil ;; !!! parent or child?
(λ call [ast scope]
;; handles every function call
;; Most calls aren't interesting, but here's the list of the ones that are:
(match ast
;; This cannot be done through the :fn feature of the compiler plugin system
;; because it needs to be called *before* the body of the function is processed.
;; TODO check if hashfn needs to be here
[-fn-]
(define-function ast scope)
[-λ-]
(define-function ast scope)
[-lambda-]
(define-function ast scope)))
(λ define-function [ast scope]
;; handle the definitions of a function
(define-function-name ast scope)
(define-function-args ast scope))
(local plugin
{:name "fennel-ls"
:versions ["1.2.0"]
:symbol-to-expression reference
:call call
:destructure define})
(λ call [ast scope]
;; handles every function call
;; Most calls aren't interesting, but here's the list of the ones that are:
(match ast
;; This cannot be done through the :fn feature of the compiler plugin system
;; because it needs to be called *before* the body of the function is processed.
;; TODO check if hashfn needs to be here
[-fn-]
(define-function ast scope)
[-λ-]
(define-function ast scope)
[-lambda-]
(define-function ast scope)
[-require- modname]
(tset require-calls ast true)))
(local filename file.uri)
(local ast
(icollect [ok ast (fennel.parser file.text filename)]
ast))
(λ on-compiler-error [_ msg ast call-me-to-reset-the-compiler]
(let [range (message.ast->range ast file)]
(table.insert diagnostics
{:range range
:message msg
:severity 3
:code 201
:codeDescription "compiler error"}))
(call-me-to-reset-the-compiler)
(error "__NOT_AN_ERROR"))
(local scope (fennel.scope))
(each [_i form (ipairs ast)]
(fennel.compile form
{: filename
: scope
:plugins [plugin]}))
;; TODO clean up this code. It's awful now that there is error handling
(let
[plugin
{:name "fennel-ls"
:versions ["1.2.0"]
:symbol-to-expression reference
:call call
:destructure define
:assert-compile on-compiler-error}]
;; write things back to the file object
(set file.references references)
(set file.definitions definitions)
;; (set file.definitions-by-scope definitions-by-scope) ;; not needed yet
(set file.ast ast))
;; (set file.compiled? true))
;; ATTEMPT TO PARSE AST
(match (pcall
#(icollect [ok ast (fennel.parser file.text file.uri {:plugins [plugin]})]
ast))
;; ON SUCCESS
(true ast)
(let [scope (fennel.scope)]
(each [_i form (ipairs ast)]
;; COMPILE
(match (pcall fennel.compile form {:filename file.uri : scope :plugins [plugin]})
(where (nil err) (not= err "__NOT_AN_ERROR"))
(error err)))
(set file.ast ast))
;; ON FAILURE
(false err)
;; RECORD THE FAILURE
(table.insert diagnostics
{:range (message.pos->range 0 0 0 0)
:message err}))
;; write things back to the file object
;; (set file.definitions-by-scope definitions-by-scope) ;; not needed yet
(set file.definitions definitions)
(set file.diagnostics diagnostics)
(set file.references references)
(set file.require-calls require-calls))))
;; (set file.compiled? true))
{: compile}

View File

@ -4,12 +4,14 @@ You finally made it. Here is the main code that implements the language server p
Every time the client sends a message, it gets handled by a function in the corresponding table type.
(ie, a textDocument/didChange notification will call notifications.textDocument/didChange
and a textDocument/defintion request will call requests.textDocument/didChange)"
(local {: pos->byte : apply-changes} (require :fennel-ls.utils))
(local message (require :fennel-ls.message))
(local state (require :fennel-ls.state))
(local language (require :fennel-ls.language))
(local formatter (require :fennel-ls.formatter))
(local {: view} (require :fennel))
(local requests [])
(local notifications [])
@ -21,7 +23,7 @@ Every time the client sends a message, it gets handled by a function in the corr
:hoverProvider {:workDoneProgress false}
;; :signatureHelpProvider nil
;; :declarationProvider nil
:definitionProvider {:workDoneProgress false}})
:definitionProvider {:workDoneProgress false}
;; :typeDefinitionProvider nil
;; :implementationProvider nil
;; :referencesProvider nil
@ -45,7 +47,7 @@ Every time the client sends a message, it gets handled by a function in the corr
;; :typeHierarchyProvider nil
;; :inlineValueProvider nil
;; :inlayHintProvider nil
;; :diagnosticProvider {:workDoneProgress false}})
:diagnosticProvider {:workDoneProgress false}})
;; :workspaceSymbolProvider nil
;; :workspace {:workspaceFolders nil
;; :documentOperations {:didCreate nil
@ -63,38 +65,39 @@ Every time the client sends a message, it gets handled by a function in the corr
(λ requests.textDocument/definition [self send {: position :textDocument {: uri}}]
(local file (state.get-by-uri self uri))
(local byte (pos->byte file.text position.line position.character))
(match (language.find-symbol file.ast byte)
symbol
(match (language.search-main self file symbol)
(result result-file) ;; curse you, magical match rules
(message.range-and-uri
(or result.binding result.?definition)
result-file))))
(match-try (language.find-symbol file.ast byte)
(symbol parents)
(match-try
(let [parent (. parents (length parents))]
(if (. file.require-calls parent)
(language.search self file parent [])))
nil
(language.search-main self file symbol))
(result result-file)
(message.range-and-uri
(or result.binding result.?definition)
result-file)
(catch _ nil)))
(λ requests.textDocument/hover [self send {: position :textDocument {: uri}}]
(local file (state.get-by-uri self uri))
(local byte (pos->byte file.text position.line position.character))
(match (language.find-symbol file.ast byte)
symbol
(match (language.search-main self file symbol)
result
{:contents
{:kind
"markdown"
:value
(formatter.hover-format result)}})))
(match-try (language.find-symbol file.ast byte)
symbol (language.search-main self file symbol)
result {:contents {:kind "markdown"
:value (formatter.hover-format result)}}))
(λ notifications.textDocument/didChange [self send {: contentChanges :textDocument {: uri}}]
(local file (state.get-by-uri self uri))
(assert file.open?)
(apply-changes (. self.files uri) contentChanges))
(state.set-uri-contents self uri (apply-changes file.text contentChanges))
(send (message.diagnostics file)))
(λ notifications.textDocument/didOpen [self send {:textDocument {: languageId : text : uri}}]
(local file (state.set-uri-contents self uri text))
(set file.open? true))
(set file.open? true)
(send (message.diagnostics file)))
(λ notifications.textDocument/didClose [self send {:textDocument {: uri}}]
;; TODO fix
(local file (state.get-by-uri self uri))
(set file.open? false))

View File

@ -1,15 +1,12 @@
(local fennel (require :fennel))
(local fennelutils (require :fennel.utils))
(local {: sym? : list? : sequence? : sym : view} (require :fennel))
(local utils (require :fennel-ls.utils))
(local state (require :fennel-ls.state))
(local get-ast-info utils.get-ast-info)
(local sym? fennel.sym?)
(local list? fennel.list?)
(local -require- (fennel.sym :require))
(local -dot- (fennel.sym :.))
(local -require- (sym :require))
(local -dot- (sym :.))
(local -do- (sym :do))
(var search nil) ;; all of the search functions are mutually recursive
@ -23,11 +20,11 @@
(search self file ?definition stack))))
(λ search-symbol [self file symbol stack]
(let [split (utils.multi-sym-split symbol)]
(fcollect [i (length split) 2 -1 &into stack]
(. split i))) ;; TODO test coverage for this line
(match (. file.references symbol)
to (search-assignment self file to stack)))
to (search-assignment self file to
(let [split (utils.multi-sym-split symbol)]
(fcollect [i (length split) 2 -1 &into stack]
(. split i)))))) ;; TODO test coverage for this line
(λ search-table [self file tbl stack]
(if (. tbl (. stack (length stack)))
@ -42,19 +39,24 @@
(let [newfile (state.get-by-module self mod)
newitem (. newfile.ast (length newfile.ast))]
(search self newfile newitem stack))
; A . form indexes into item 1 with the other items
[-dot- & split]
(do
(search self file (. split 1)
(fcollect [i (length split) 2 -1 &into stack]
(. split i))
(search self file (. split 1) stack))))
(. split i)))
;; A do block returns the last form
[-do- & body]
(search self file (. body (length body)) stack)))
(set search
(λ search [self file item stack]
(if (fennelutils.table? item) (search-table self file item stack)
(if
(sym? item) (search-symbol self file item stack)
(list? item) (search-list self file item stack)
(= :table (type item)) (search-table self file item stack)
(= 0 (length stack)) {:?definition item} ;; BASE CASE !!
(error (.. "I don't know what to do with " (fennel.view item))))))
(error (.. "I don't know what to do with " (view item))))))
(λ search-main [self file symbol]
;; TODO partial byting, go to different defitition sites depending on which section of the symbol the trigger happens on
@ -103,29 +105,37 @@
byte
(+ 1 (get-ast-info ?ast :byteend))))))
(λ find-symbol [ast byte ?recursively-called]
(λ find-symbol [ast byte ?stack]
(local stack (or ?stack []))
(if (or (not= :table (type ast))
(does-not-contain? ast byte))
nil
(and (sym? ast) (contains? ast byte))
ast
(or (not ?recursively-called)
(fennel.list? ast)
(fennel.sequence? ast))
(values ast [])
(or (= 0 (length stack))
(list? ast)
(sequence? ast))
;; TODO binary search
(accumulate
[result nil
[(result stack*) nil
_ v (ipairs ast)
&until (or result (past? v byte))]
(find-symbol v byte true))
:else
(do
(table.insert stack ast)
(match (find-symbol v byte stack)
ret (values ret stack)
nil (do (table.remove stack) nil))))
(accumulate
[result nil
[(result stack*) nil
k v (pairs ast)
&until result]
(or
(find-symbol k byte true)
(find-symbol v byte true)))))
(do
(table.insert stack ast)
(match (or (find-symbol k byte stack)
(find-symbol v byte stack))
ret (values ret stack)
nil (do (table.remove stack) nil))))))
{: find-symbol
: search-main}
: search-main
: search}

View File

@ -7,7 +7,6 @@ missing fields with null fields, and I want to have one location
to look to fix this in the future."
(local utils (require :fennel-ls.utils))
(local state (require :fennel-ls.state))
(local error-codes
{;; JSON-RPC errors
@ -47,21 +46,38 @@ to look to fix this in the future."
: id
:result ?result})
(λ range-and-uri [?ast file]
"if possible, returns the location of a symbol"
(match
(values
(utils.get-ast-info ?ast :bytestart)
(utils.get-ast-info ?ast :byteend))
(λ pos->range [sl sc el ec]
{:start {:line sl :character sc}
:end {:line el :character ec}})
(λ ast->range [?ast file]
(match (values (utils.get-ast-info ?ast :bytestart)
(utils.get-ast-info ?ast :byteend))
(i j)
(let [(start-line start-col) (utils.byte->pos file.text i)
(end-line end-col) (utils.byte->pos file.text (+ j 1))]
{:range {:start {:line start-line :character start-col}
:end {:line end-line :character end-col}}
:uri file.uri})))
(pos->range start-line start-col end-line end-col))))
(λ range-and-uri [?ast {: uri &as file}]
"if possible, returns the location of a symbol"
(match (ast->range ?ast file)
range {: range : uri}))
(λ log [msg]
(create-notification :window/logMessage {: msg :type 4}))
(λ diagnostics [file]
(create-notification
"textDocument/publishDiagnostics"
{:uri file.uri
:diagnostics file.diagnostics}))
{: create-notification
: create-request
: create-response
: create-error
: range-and-uri}
: pos->range
: ast->range
: log
: range-and-uri
: diagnostics}

View File

@ -1,6 +1,5 @@
(local utils (require :fennel-ls.utils))
(local searcher (require :fennel-ls.searcher))
(local {: compile} (require :fennel-ls.compiler))
(λ init-state [self params]
@ -23,7 +22,6 @@
(λ get-by-path [self path]
(get-by-uri (utils.path->uri path)))
(λ get-by-module [self module]
;; check the cache
(match (. self.modules module)
@ -45,18 +43,18 @@
(match (. self.files uri)
;; modify existing file
file
(when (not= text file.text)
(set file.text text)
(compile file)
(do
(when (not= text file.text)
(set file.text text)
(compile file))
file)
;; create new file
nil
(let [file {: uri : text}]
(tset self.files uri file)
(compile file)
file)))
(tset self.files uri file)
(compile file)
file)))
{: get-by-uri
: get-by-module

42
test/diagnostic-test.fnl Normal file
View File

@ -0,0 +1,42 @@
(import-macros {: is-matching : describe : it : before-each} :test)
(local is (require :luassert))
(local {: view} (require :fennel))
(local {: ROOT-URI
: setup-server} (require :test.util))
(local dispatch (require :fennel-ls.dispatch))
(local message (require :fennel-ls.message))
(describe "diagnostic messages"
(it "handles compile errors"
(local state (doto [] setup-server))
(let
[responses
(dispatch.handle* state
(message.create-notification "textDocument/didOpen"
{:textDocument
{:uri (.. ROOT-URI "imaginary-file.fnl")
:languageId "fennel"
:version 1
:text "(do do)"}}))]
(is-matching
responses
[{:params {:diagnostics [diagnostic]}}]
"")))
(it "handles parse errors"
(local state (doto [] setup-server))
(let
[responses
(dispatch.handle* state
(message.create-notification "textDocument/didOpen"
{:textDocument
{:uri (.. ROOT-URI "imaginary-file.fnl")
:languageId "fennel"
:version 1
:text "(do (print :hello(]"}}))]
(is-matching
responses
[{:params {:diagnostics [diagnostic]}}]
""))))

View File

@ -1,7 +1,6 @@
(import-macros {: is-matching : describe : it : before-each} :test.macros)
(import-macros {: is-matching : describe : it : before-each} :test)
(local is (require :luassert))
(local fennel (require :fennel))
(local {: ROOT-URI
: setup-server} (require :test.util))
@ -64,11 +63,11 @@
(check :goto-definition.fnl 38 15 :goto-definition.fnl 33 7 33 13))
(it "can go up and down field accesses"
(check :goto-definition.fnl 45 15 :goto-definition.fnl 40 7 40 13)))
(check :goto-definition.fnl 45 15 :goto-definition.fnl 40 7 40 13))
;; (it "works directly on a require/include (require XXX))"
;; (check :goto-definition.fnl 1 5 :bar.fnl 0 0 0 0)))
(it "works directly on a require/include (require XXX))"
(check :goto-definition.fnl 1 5 :bar.fnl 0 0 0 2)))
;; (it "can go to a reference that occurs in a macro")
;; (it "doesn't have ghost definitions from the same byte ranges as the macro files it's using")

View File

@ -1,7 +1,7 @@
(import-macros {: is-matching : describe : it : before-each} :test.macros)
(import-macros {: is-matching : describe : it : before-each} :test)
(local is (require :luassert))
(local fennel (require :fennel))
(local {: view} (require :fennel))
(local {: ROOT-URI
: setup-server} (require :test.util))
@ -23,7 +23,7 @@
{:contents
{:kind "markdown"
:value response-string}}}]
(.. "expected response: " (fennel.view response-string)))))
(.. "expected response: " (view response-string)))))
(it "hovers over a function"
(check "hover.fnl" 6 6 "```fnl\n(fn my-function [arg1 arg2 arg3] ...)\n```"))

View File

@ -6,3 +6,4 @@
(require :test.goto-definition-test)
(require :test.hover-test)
(require :test.misc-test)
(require :test.diagnostic-test)

View File

@ -1,7 +1,6 @@
(import-macros {: is-matching : describe : it} :test.macros)
(import-macros {: is-matching : describe : it} :test)
(local is (require :luassert))
(local fennel (require :fennel))
(local stringio (require :test.pl.stringio))
(local json-rpc (require :fennel-ls.json-rpc))

View File

@ -1,4 +1,4 @@
(import-macros {: is-matching : describe : it} :test.macros)
(import-macros {: is-matching : describe : it} :test)
(local is (require :luassert))
(local {: ROOT-PATH : ROOT-URI} (require :test.util))

View File

@ -1,4 +1,4 @@
(import-macros {: is-matching : describe : it : before-each} :test.macros)
(import-macros {: is-matching : describe : it : before-each} :test)
(local is (require :luassert))
(local fennel (require :fennel))

View File

@ -1,4 +1,4 @@
(import-macros {: is-matching : describe : it} :test.macros)
(import-macros {: is-matching : describe : it} :test)
(local is (require :luassert))
(local fennel (require :fennel))

View File

@ -1 +1 @@
nil
{}