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

More progress

Browse Source
This commit is contained in:
XeroOl 2022-07-30 01:30:01 -05:00
parent 9815dae79d
commit 3c91ad0680
No known key found for this signature in database
GPG Key ID: 9DD4B4B4DAED0322
18 changed files with 234 additions and 372 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
LICENSE
View File

@ -1 +1,19 @@
MIT
Copyright (c) 2022 XeroOl
Permission is hereby granted, free of charge, to any person obtaining a copy of
this software and associated documentation files (the "Software"), to deal in
the Software without restriction, including without limitation the rights to
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
of the Software, and to permit persons to whom the Software is furnished to do
so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

11
Makefile
View File

@ -1,13 +1,14 @@
STATIC_LUA_LIB=/usr/lib/liblua.so.5.4
LUA_LIB=/usr/lib/liblua.so.5.4
LUA_INCLUDE_PATH=$(shell lua5.4 -e 'print(package.cpath:match("[^;]+"))')
SOURCES=$(wildcard *.fnl)
SOURCES+=$(wildcard fls/*.fnl)
SOURCES=$(wildcard src/*.fnl)
SOURCES+=$(wildcard src/fennel-ls/*.fnl)
.PHONY: test
fennel-ls: $(SOURCES)
fennel --compile-binary main.fnl fennel-ls $(STATIC_LUA_LIB) $(LUA_INCLUDE_PATH)
FENNEL_PATH=src/?.fnl fennel --compile-binary src/fennel-ls.fnl fennel-ls $(LUA_LIB) $(LUA_INCLUDE_PATH)
test:
fennel test.fnl
fennel --correlate test/init.fnl

89
fennel-ls.fnl
View File

@ -1,89 +0,0 @@
(local fennel (require :fennel))
(local {: make-error-message} (require :fls.error))
(local requests [])
(local notifications [])
(local capabilities
{:textDocumentSync 2
:notebookDocumentSync nil
:completionProvider nil
:hoverProvider nil
:signatureHelpProvider nil
:declarationProvider nil
:definitionProvider nil
:typeDefinitionProvider nil
:implementationProvider nil
:referencesProvider nil
:documentHighlightProvider nil
:documentSymbolProvider nil
:codeActionProvider nil
:codeLensProvider nil
:documentLinkProvider nil
:colorProvider nil
:documentFormattingProvider nil
:documentRangeFormattingProvider nil
:documentOnTypeFormattingProvider nil
:renameProvider nil
:foldingRangeProvider nil
:executeCommandProvider nil
:selectionRangeProvider nil
:linkedEditingRangeProvider nil
:callHierarchyProvider nil
:semanticTokensProvider nil
:monikerProvider nil
:typeHierarchyProvider nil
:inlineValueProvider nil
:inlayHintProvider nil
:diagnosticProvider nil
:workspaceSymbolProvider nil})
; :workspace {:workspaceFolders nil
; :fileOperations {:didCreate nil
; :willCreate nil
; :didRename nil
; :willRename nil
; :didDelete nil
; :willDelete nil})
(λ requests.initialize [self params]
{:capabilities capabilities
:serverInfo {:name "fennel-ls" :version "0.0.0"}})
(λ requests.shutdown [self])
;; Okay, I'll wait for the exit notification to actaully exit
(λ notifications.exit [self]
(os.exit 0))
(λ run-request [self id method ?params]
(match (. requests method)
callback {:jsonrpc "2.0"
: id
:result (callback self ?params)}
nil (make-error-message
:MethodNotFound
(.. "\"" method "\" is not in the requests table")
id)))
(λ run-response [self id result])
;; I don't care about responses yet
(λ run-bad-response [self id err]
(error (.. "oopsie: " err.code)))
(λ run-notification [self method ?params]
(match (. notifications method)
callback (callback self ?params)
nil nil)) ;; Silent error for unknown notifications
(λ run [self msg]
"The entry point for all messages."
(match (values msg (type msg))
{:jsonrpc "2.0" : id : method :params ?params} (run-request self id method ?params)
{:jsonrpc "2.0" : method :params ?params} (run-notification self method ?params)
{:jsonrpc "2.0" : id : result} (run-response self id result)
{:jsonrpc "2.0" : id :error err} (run-bad-response self id err)
(str :string) (make-error-message :ParseError str)
_ (make-error-message :BadMessage nil msg.id)))
{: run}

23
fls/error.fnl
View File

@ -1,23 +0,0 @@
(local error-codes
{;; JSON-RPC errors
:ParseError -32700
:InvalidRequest -32600
:MethodNotFound -32601
:InvalidParams -32602
:InternalError -32603
;; LSP errors
:ServerNotInitialized -32002
:UnknownErrorCode -32001
:RequestFailed -32802 ;; when the server has no excuse
:ServerCancelled -32802
:ContentModified -32801 ;; I don't think this one is useful
:RequestCancelled -32800}) ;; I don't think I'm going to even support cancelling things, that sounds like a pain
(λ make-error-message [code message ?id ?data]
{:jsonrpc "2.0"
:id ?id
:error {:code (or (. error-codes code) code)
:data ?data
: message}})
{: error-codes : make-error-message}

29
fls/file.fnl
View File

@ -1,29 +0,0 @@
(local stringx (require :pl.stringx))
(λ open-uri [uri]
(local prefix "file://")
(assert (stringx.startswith uri prefix))
(let [path (string.sub uri 8)]
(io.open path)))
(λ make-file [uri lines]
{: uri
: lines})
(λ make-file-from-disk [uri]
(make-file
uri
(with-open [file (open-uri uri)]
(icollect [line (file:lines)]
line))))
(λ sub [self start-line start-char end-line end-char replacement]
(local index (+ 1 start-line))
(tset self.lines index
(.. (string.sub (. self.lines index) 1 start-char)
replacement
(string.sub (. self.lines index) (+ 1 end-char)))))
{: make-file
: make-file-from-disk
: sub}

4
fls/init.fnl
View File

@ -1,4 +0,0 @@
{:error (require :fls.error)
:log (require :fls.log)
:protocol (require :fls.protocol)
:file (require :fls.file)}

16
fls/log.fnl
View File

@ -1,16 +0,0 @@
(local fennel (require :fennel))
(local disable-logs false)
(if disable-logs
{:log #nil}
(let [logfile (io.open "/tmp/fennel.log" "w")]
(assert logfile)
(fn log [...]
(let [args []]
(for [i 1 (select :# ...)]
(table.insert args
(let [item (select i ...)]
(match (values item (type item))
(str :string) str
?any (fennel.view ?any)))))
(logfile:write (table.concat args) "\n")))
{: log}))

58
fls/protocol.fnl
View File

@ -1,58 +0,0 @@
" Language Server Protocol I/O
This module implements the parsing and formatting needed to read/write messages using the language server protocol.
There are only two functions exposed here:
* `read` receives a message from the client.
* `write` sends a message to the client."
;; TODO find json library that doesn't conflate missing fields with null
(local {: encode : decode} (require :json.json))
(local {: split} (require :pl.stringx))
(λ read-header [in ?header]
(let [header (or ?header {})]
(match (in:read)
"\r" header ;; hit an empty line, I'm done reading
nil nil ;; hit end of stream, return nil
;; reading an actual line
header-line
(let [[k v] (split header-line ": " 2)]
(tset header k (string.sub v 1 -2))
(read-header in header)))))
(λ read-n [in len ?buffer]
"read a string of exactly `len` characters from the `in` stream.
If there aren't enough bytes, return nil"
(local buffer (or ?buffer []))
(if (<= len 0)
(table.concat buffer)
(match (in:read len)
content
(read-n in
(- len (length content))
(doto buffer (table.insert content))))))
(λ read-content [in header]
(read-n in (tonumber header.Content-Length)))
(λ read [in]
"Reads the next Language Server Protocol message from the given input stream"
(let [(_success? result)
(-?>>
(read-header in)
(read-content in)
(pcall decode))]
result))
(λ write [out msg]
"Writes a Language Server Protocol message to the given output stream"
(let [content (encode msg)
msg-stringified (.. "Content-Length: " (length content) "\r\n\r\n" content)]
(out:write msg-stringified)
(when out.flush
(out:flush))))
{: read
: write}

20
main.fnl
View File

@ -1,20 +0,0 @@
(local fennel (require :fennel))
(local fls (require :fls))
(local {: run} (require :fennel-ls))
(λ main-loop [in out]
(var state {})
(while
(let [msg (fls.protocol.read in)]
(fls.log.log msg)
(-?>> msg
(run state)
(fls.protocol.write out))
msg)))
(λ main []
(main-loop
(io.input)
(io.output)))
(main)

19
src/fennel-ls.fnl Normal file
View File

@ -0,0 +1,19 @@
(local fennel (require :fennel))
(local dispatch (require :fennel-ls.dispatch))
(local json-rpc (require :fennel-ls.json-rpc))
(local {: log} (require :fennel-ls.log))
(λ main-loop [in out]
(local send #(json-rpc.write out $))
(local state [])
(while true
(let [msg (json-rpc.read in)]
(log msg)
(dispatch.handle state send msg))))
(λ main []
(main-loop
(io.input)
(io.output)))
(main)

5
test.fnl
View File

@ -1,5 +0,0 @@
((require :busted.runner))
(require :test.protocol-test)
(require :test.file-test)
(require :test.lsp-test)

91
test/document-test.fnl Normal file
View File

@ -0,0 +1,91 @@
(import-macros {: assert-matches : describe : it} :test.macros)
(local assert (require :luassert))
(local fennel (require :fennel))
(local stringx (require :pl.stringx))
(local document (require :fennel-ls.document))
(local ROOT-URI
(.. "file://"
(-> (io.popen "pwd")
(: :read :*a)
(stringx.strip))))
(local FILE-URI (.. ROOT-URI "/test_document"))
(describe "document"
(describe "create-from-disk"
(it "opens documents from disk"
(local uri (.. ROOT-URI "/test/init.fnl"))
(local test-fnl-document (document.create-from-disk uri))
(assert.equal (. test-fnl-document.lines 1)
"((require :busted.runner))"))
(it "crashes on bad file"
(assert.errors #(document.create-from-disk "fill://my/path/here"))
(assert.errors #(document.create-from-disk "file:///this/path/hopefully/does/not/exist/on/the/host/system&^$!@#%"))))
(describe "create-from-contents"
(it "opens documents from fixed contents"
(local uri (.. ROOT-URI "/test_document"))
(assert-matches
(document.create-from-contents uri "line 1\nline 2\nline 3")
{:lines ["line 1" "line 2" "line 3"]})))
(describe "sub"
(it "updates the start of a line"
(local my-document (document.create FILE-URI ["replace beginning"]))
(document.sub my-document 0 0 0 7 "the")
(assert-matches my-document {:lines ["the beginning"]}))
(it "updates the end of a line"
(local my-document (document.create FILE-URI ["replace end"]))
(document.sub my-document 0 7 0 11 "ment")
(assert-matches my-document {:lines ["replacement"]}))
(it "replaces a line"
(local my-document (document.create FILE-URI ["replace all"]))
(document.sub my-document 0 0 0 11 "new string")
(assert-matches my-document {:lines ["new string"]})))
;; fixme:
;; test for errors on out of bounds
;; test for multiline edits
;; test for unicode utf8 utf16 nightmare
;; (it "can handle unicode"
;; (local uri (.. ROOT-URI "test_document"))
;; (local my-document (document.create uri [""]))
;; (document.sub my-document 0 0 0 0 "どれみふぁそらてぃど")
;; (document.sub my-document 0 1 0 3 "😀")
;; (document.sub my-document 0 11 0 11 "end")
;; (assert-matches my-document {:lines ["ど😀ふぁそらてぃどend"]})))
(describe "apply-changes"
(it "can handle substituting things"
(local my-document (document.create FILE-URI ["replace beginning"]))
(document.apply-changes
my-document
[{:range {:start {:line 0 :character 0}
:end {:line 0 :character 7}}
:text "the"}])
(assert-matches my-document {:lines ["the beginning"]}))
(it "can handle replacing everything"
(local my-document (document.create FILE-URI ["this is the" "old file"]))
(document.apply-changes
my-document
[{:text "And this is the\nnew file"}])
(assert-matches my-document {:lines ["And this is the" "new file"]})))
(describe "lines"
(it "splits lines"
(assert.same (document.lines "hello world\nnewlines are fun\rgaming\r\nworld
double double\r\n\ndouble trouble\n\r\nfunny\r\rand\n\nfinal")
["hello world" "newlines are fun"
"gaming" "world" "double double"
"" "double trouble"
"" "funny" "" "and"
"" "final"]))))

60
test/file-test.fnl
View File

@ -1,60 +0,0 @@
(import-macros {: assert-matches : describe : it} :test.macros)
(local assert (require :luassert))
(local fennel (require :fennel))
(local fls (require :fls))
(local stringx (require :pl.stringx))
(local ROOT-URI
(.. "file://"
(-> (io.popen "pwd")
(: :read :*a)
(stringx.strip))
"/"))
(local FILE-URI (.. ROOT-URI "test_file"))
(describe "File Loading"
(it "can open files from disk"
(local uri (.. ROOT-URI "test.fnl"))
(local test-fnl-file (fls.file.make-file-from-disk uri))
(assert.equal (. test-fnl-file.lines 1)
"((require :busted.runner))"))
(it "can open files from fixed contents"
(local uri (.. ROOT-URI "test_file"))
(local my-file (fls.file.make-file uri ["line 1" "line 2" "line 3"]))
(assert
(match my-file
{:lines ["line 1" "line 2" "line 3"]}
true
otherwise (values false (fennel.view otherwise)))))
(it "can update the start of a line"
(local my-file (fls.file.make-file FILE-URI ["replace beginning"]))
(fls.file.sub my-file 0 0 0 7 "the")
(assert-matches my-file {:lines ["the beginning"]}))
(it "can update the end of a line"
(local my-file (fls.file.make-file FILE-URI ["replace end"]))
(fls.file.sub my-file 0 7 0 11 "ment")
(assert-matches my-file {:lines ["replacement"]}))
(it "can replace a line"
(local my-file (fls.file.make-file FILE-URI ["replace all"]))
(fls.file.sub my-file 0 0 0 11 "new string")
(assert-matches my-file {:lines ["new string"]})))
;; next steps:
;; test for errors on out of bounds
;; test for multiline edits
;; test for unicode utf8 utf16 nightmare
;; (it "can handle unicode"
;; (local uri (.. ROOT-URI "test_file"))
;; (local my-file (fls.file.make-file uri [""]))
;; (fls.file.sub my-file 0 0 0 0 "どれみふぁそらてぃど")
;; (fls.file.sub my-file 0 1 0 3 "😀")
;; (fls.file.sub my-file 0 11 0 11 "end")
;; (assert-matches my-file {:lines ["ど😀ふぁそらてぃどend"]})))

5
test/init.fnl Normal file
View File

@ -0,0 +1,5 @@
((require :busted.runner))
(tset (require :fennel) :path "./?.fnl;./src/?.fnl")
(require :test.json-rpc-test)
(require :test.document-test)
(require :test.lsp-test)

40
test/json-rpc-test.fnl Normal file
View File

@ -0,0 +1,40 @@
(import-macros {: assert-matches : describe : it} :test.macros)
(local assert (require :luassert))
(local fennel (require :fennel))
(local stringio (require :pl.stringio))
(local json-rpc (require :fennel-ls.json-rpc))
(describe "json-rpc"
(describe "read"
(it "parses incoming messages"
(let [out (stringio.open
"Content-Length: 29\r\n\r\n{\"my json content\":\"is cool\"}")]
(assert.same
{"my json content" "is cool"}
(json-rpc.read out))))
(it "can read multiple incoming messages"
(let [out (stringio.open
"Content-Length: 29\r\n\r\n{\"my json content\":\"is cool\"}Content-Length: 29\r\n\r\n{\"my json content\":\"is neat\"}")]
(assert.same
{"my json content" "is cool"}
(json-rpc.read out))
(assert.same
{"my json content" "is neat"}
(json-rpc.read out))
(assert.same
nil
(json-rpc.read out))))
(it "can report compiler errors"
(let [out (stringio.open "Content-Length: 9\r\n\r\n{{{{{}}}}")]
(assert (= (type (json-rpc.read out)) :string)))))
(describe "write"
(it "serializes outgoing messages"
(let [in (stringio.create)]
(json-rpc.write in {"my json content" "is cool"})
(assert.same "Content-Length: 29\r\n\r\n{\"my json content\":\"is cool\"}"
(in:value))))))

67
test/lsp-test.fnl
View File

@ -1,29 +1,50 @@
(import-macros {: assert-matches : describe : it} :test.macros)
(local assert (require :luassert))
(local {: run} (require :fennel-ls))
(local fennel (require :fennel))
(local dispatch (require :fennel-ls.dispatch))
(local stringx (require :pl.stringx))
(describe "initialization"
;; TODO get rid of hardcoded paths here
(local ROOT-PATH
(-> (io.popen "pwd")
(: :read :*a)
(stringx.strip)))
(local ROOT-URI
(.. "document://" ROOT-PATH))
(local server-initialize-message
{:id 1
:jsonrpc "2.0"
:method "initialize"
:params
{:capabilities {}
:clientInfo {:name "Neovim" :version "0.7.2"}
:initializationOptions {}
:processId 16245
:rootPath ROOT-PATH
:rootUri ROOT-URI
:trace "off"
:workspaceFolders [{:name ROOT-PATH
:uri ROOT-URI}]}})
(describe "language server"
(it "responds to initialize"
(local initialize
{:id 1
:jsonrpc "2.0"
:method "initialize"
:params
{:capabilities {}
:clientInfo {:name "Neovim" :version "0.7.2"}
:initializationOptions {}
:processId 16245
:rootPath "/home/xerool/Documents/projects/fennel-ls"
:rootUri "file:///home/xerool/Documents/projects/fennel-ls"
:trace "off"
:workspaceFolders [{:name "/home/xerool/Documents/projects/fennel-ls"
:uri "file:///home/xerool/Documents/projects/fennel-ls"}]}})
(assert-matches
(run [] initialize)
{:id 1
:jsonrpc "2.0"
:result {:capabilities {}
:serverInfo {:name "fennel-ls" : version}}})))
(dispatch.handle* [] server-initialize-message)
[{:id 1
:jsonrpc "2.0"
:result {:capabilities {}
:serverInfo {:name "fennel-ls" : version}}}]))
(it "can jump to definition"
(local state [])
(dispatch.handle* state server-initialize-message)
(assert-matches
(dispatch.handle* state
{:id 2
:jsonrpc "2.0"
:method "textDocument/definition"
:params {:position {:character 5 :line 0}
:textDocument {:uri (.. ROOT-URI "/test.fnl")}}})
[{:id 2
:jsonrpc "2.0"
:result {: uri : range}}]))) ;; FIXME: test whether the location is correct

15
test/macros.fnl
View File

@ -1,12 +1,17 @@
(fn it [title ...]
`((. (require :busted) :it)
,title (fn [] ,...)))
"This document does not include tests. Instead it includes macros that are used for tests."
(fn describe [title ...]
(fn it [desc ...]
"busted's `it` function"
`((. (require :busted) :it)
,desc (fn [] ,desc ,...)))
(fn describe [desc ...]
"busted's `describe` function"
`((. (require :busted) :describe)
,title (fn [] ,...)))
,desc (fn [] ,desc ,...)))
(fn assert-matches [item pattern]
"check if item matches a pattern according to fennel's `match` builtin"
`(match ,item
,pattern nil
?otherwise#

34
test/protocol-test.fnl
View File

@ -1,34 +0,0 @@
(import-macros {: assert-matches : describe : it} :test.macros)
(local assert (require :luassert))
(local fennel (require :fennel))
(local stringio (require :pl.stringio))
(local fls (require :fls))
(local {: run} (require :fennel-ls))
(describe "fls.protocol"
(it "parses incoming messages"
(let [out (stringio.open "Content-Length: 29\r\n\r\n{\"my json content\":\"is cool\"}")]
(assert.same {"my json content" "is cool"}
(fls.protocol.read out))))
(it "serializes outgoing messages"
(let [in (stringio.create)]
(fls.protocol.write in {"my json content" "is cool"})
(assert.same "Content-Length: 29\r\n\r\n{\"my json content\":\"is cool\"}"
(in:value))))
(it "can read multiple incoming messages"
(let [out (stringio.open "Content-Length: 29\r\n\r\n{\"my json content\":\"is cool\"}Content-Length: 29\r\n\r\n{\"my json content\":\"is cool\"}")]
(assert.same {"my json content" "is cool"}
(fls.protocol.read out))
(assert.same {"my json content" "is cool"}
(fls.protocol.read out))
(assert.same nil
(fls.protocol.read out))))
(it "can report the ParseError code"
(let [out (stringio.open "Content-Length: 9\r\n\r\n{{{{{}}}}")]
(assert-matches
(run [] (fls.protocol.read out))
{:error {:code -32700} :jsonrpc "2.0"}))))