From 528b770b7b9571d524e253cdc0c6fb3888464207 Mon Sep 17 00:00:00 2001 From: XeroOl Date: Wed, 27 Jul 2022 23:16:42 -0500 Subject: [PATCH] added very basic file support, no fileedit syncing yet --- Makefile | 7 ++++ fennel-ls.fnl | 80 ++++++++++++++++++++-------------------- fls/error.fnl | 23 ++++++++++++ fls/init.fnl | 4 ++ fls/io.fnl | 58 +++++++++++++++++++++++++++++ fls/log.fnl | 16 ++++++++ fls/state.fnl | 36 ++++++++++++++++++ lsp-io.fnl | 44 ---------------------- main.fnl | 25 ++++++++----- test.fnl | 100 ++++++++++++++++++++++++++++++++------------------ 10 files changed, 265 insertions(+), 128 deletions(-) create mode 100644 fls/error.fnl create mode 100644 fls/init.fnl create mode 100644 fls/io.fnl create mode 100644 fls/log.fnl create mode 100644 fls/state.fnl delete mode 100644 lsp-io.fnl diff --git a/Makefile b/Makefile index 191b2dd..91d9a19 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,14 @@ STATIC_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) + +.PHONY: test fennel-ls: $(SOURCES) fennel --compile-binary main.fnl fennel-ls $(STATIC_LUA_LIB) $(LUA_INCLUDE_PATH) +test: + @echo testing + fennel test.fnl + diff --git a/fennel-ls.fnl b/fennel-ls.fnl index 95a8c8d..ead6262 100644 --- a/fennel-ls.fnl +++ b/fennel-ls.fnl @@ -1,9 +1,11 @@ +(local fennel (require :fennel)) +(local {: make-error-message} (require :fls.error)) + (local requests []) (local notifications []) (local capabilities - {:positionEncoding "utf-8" - :textDocumentSync nil + {:textDocumentSync 2 :notebookDocumentSync nil :completionProvider nil :hoverProvider nil @@ -34,54 +36,54 @@ :inlineValueProvider nil :inlayHintProvider nil :diagnosticProvider nil - :workspaceSymbolProvider nil - :workspace {:workspaceFolders nil - :fileOperations {:didCreate nil - :willCreate nil - :didRename nil - :willRename nil - :didDelete nil - :willDelete nil}}}) + :workspaceSymbolProvider nil}) +; :workspace {:workspaceFolders nil +; :fileOperations {:didCreate nil +; :willCreate nil +; :didRename nil +; :willRename nil +; :didDelete nil +; :willDelete nil}) -(λ requests.initialize [params] +(λ requests.initialize [self params] {:capabilities capabilities :serverInfo {:name "fennel-ls" :version "0.0.0"}}) -(λ requests.shutdown []) - ;; no op +(λ requests.shutdown [self]) + ;; Okay, I'll wait for the exit notification to actaully exit -(λ notifications.exit [] +(λ notifications.exit [self] (os.exit 0)) -(λ handle-request [id method ?params] - (let [callback (. requests method) - result {: id :jsonrpc "2.0"}] - (if callback - (tset result :result (callback ?params)) - (tset result :error (.. "Unknown message type: " method))) - result)) +(λ 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))) -(λ handle-response [id result]) - ;; Do nothing +(λ run-response [self id result]) + ;; I don't care about responses yet -(λ handle-bad-response [id err] +(λ run-bad-response [self id err] (error (.. "oopsie: " err.code))) -(λ handle-notification [method ?params] - (let [callback (. notifications method)] - (if callback - (callback ?params)))) +(λ run-notification [self method ?params] + (match (. notifications method) + callback (callback self ?params) + nil nil)) ;; Silent error for unknown notifications -(λ handle [msg] +(λ run [self msg] "The entry point for all messages." - (assert (= msg.jsonrpc "2.0") "Aha! You forgot to repeat that jsonrpc is version 2.0!") - (match msg - {: id : method :params ?params} (handle-request id method ?params) - {: method :params ?params} (handle-notification method ?params) - {: id : result} (handle-response id result) - {: id :error err} (handle-bad-response id err) - _ {:id msg.id - :error "I just received a message that doesn't make sense to me" - :jsonrpc "2.0"})) + (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))) -{: handle} +{: run} diff --git a/fls/error.fnl b/fls/error.fnl new file mode 100644 index 0000000..70ecaae --- /dev/null +++ b/fls/error.fnl @@ -0,0 +1,23 @@ +(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} diff --git a/fls/init.fnl b/fls/init.fnl new file mode 100644 index 0000000..f215e76 --- /dev/null +++ b/fls/init.fnl @@ -0,0 +1,4 @@ +{:error (require :fls.error) + :io (require :fls.io) + :state (require :fls.state) + :log (require :fls.log)} diff --git a/fls/io.fnl b/fls/io.fnl new file mode 100644 index 0000000..bd37a3a --- /dev/null +++ b/fls/io.fnl @@ -0,0 +1,58 @@ +" 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} diff --git a/fls/log.fnl b/fls/log.fnl new file mode 100644 index 0000000..fd60ec0 --- /dev/null +++ b/fls/log.fnl @@ -0,0 +1,16 @@ +(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})) diff --git a/fls/state.fnl b/fls/state.fnl new file mode 100644 index 0000000..4e86ceb --- /dev/null +++ b/fls/state.fnl @@ -0,0 +1,36 @@ +(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 ?dirty] + {: uri + : lines + :dirty? ?dirty}) + +(λ make-file-from-disk [uri] + (make-file + uri + (with-open [file (open-uri uri)] + (icollect [line (file:lines)] + line)) + false)) + +(fn add-file [self uri ?contents] + ;; assert file isn't loaded yet + (assert (not (. self.files uri))) + (tset + self.files + uri + (make-file-from-disk uri))) + +(fn new-state [] + {:files {}}) + ; :variables {} + ; :settings {} + ; :other-things {} + +{: new-state : add-file} diff --git a/lsp-io.fnl b/lsp-io.fnl deleted file mode 100644 index 7a38f8f..0000000 --- a/lsp-io.fnl +++ /dev/null @@ -1,44 +0,0 @@ -(local {: encode : decode} (require :json.json)) -(local {: split} (require :pl.stringx)) - -(λ read-header [in ?header] - (let [header (or ?header {})] - (match (in:read) - ;; base cases - "\r" header - nil 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-content [in header] - (let [len (tonumber header.Content-Length) - buffer []] - ;; TODO make this code as tolerable as possible - (var sofar 0) - (var currently-read-bytes nil) - (while - (and (< sofar len) - (do (set currently-read-bytes (in:read (- len sofar))) - currently-read-bytes)) - (set sofar (+ sofar (length currently-read-bytes))) - (table.insert buffer currently-read-bytes)) - (decode (table.concat buffer)))) - - -(λ read-message [in] - (match (read-header in) - header (read-content in header) - nil nil)) - -(λ write-message [out msg] - (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-message - : write-message} diff --git a/main.fnl b/main.fnl index 98e5264..54e64b7 100644 --- a/main.fnl +++ b/main.fnl @@ -1,16 +1,21 @@ (local fennel (require :fennel)) -(local {: read-message : write-message} (require :lsp-io)) -(local {: handle} (require :fennel-ls)) +(local fls (require :fls)) +(local {: run} (require :fennel-ls)) +(local {: make-error-message} (require :fls.error)) -(λ main-loop [in out] - (let [msg (read-message in)] - (when msg - (let [response (handle msg)] - (when response - (write-message out response)) - (main-loop in out))))) +(λ main-loop [in out state] + (while + (let [msg (fls.io.read in)] + (fls.log.log msg) + (-?>> msg + (run state) + (fls.io.write out)) + msg))) (λ main [] - (main-loop (io.input) (io.output))) + (main-loop + (io.input) + (io.output) + (fls.state.new-state))) (main) diff --git a/test.fnl b/test.fnl index a05f610..efe7e73 100644 --- a/test.fnl +++ b/test.fnl @@ -1,9 +1,10 @@ -(local {: handle} (require :fennel-ls)) -(local {: read-message : write-message} (require :lsp-io)) +(local fennel (require :fennel)) +(local fls (require :fls)) (local stringio (require :pl.stringio)) -(local {: view} (require :fennel)) -(local busted (require :busted)) +(local stringx (require :pl.stringx)) +(local {: run} (require :fennel-ls)) +(local busted (require :busted)) ((require :busted.runner)) (macro it! [title ...] `(busted.it ,title (fn [] ,...))) @@ -11,32 +12,45 @@ (describe! "fennel-ls" - (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"} - (read-message out)))) + (describe! "fls.io" + (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.io.read out)))) - (it! "serializes outgoing messages" - (let [in (stringio.create)] - (write-message in {"my json content" "is cool"}) - (assert.same "Content-Length: 29\r\n\r\n{\"my json content\":\"is cool\"}" - (in:value)))) + (it! "serializes outgoing messages" + (let [in (stringio.create)] + (fls.io.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 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"} - (read-message out)) - (assert.same {"my json content" "is cool"} - (read-message out)) - (assert.same nil - (read-message 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 cool\"}")] + (assert.same {"my json content" "is cool"} + (fls.io.read out)) + (assert.same {"my json content" "is cool"} + (fls.io.read out)) + (assert.same nil + (fls.io.read out)))) - (it! "responds to initialize" - (local initialize-message - {:id 1 - :jsonrpc "2.0" - :method "initialize" - :params + (it! "can report the ParseError code" + (let [out (stringio.open "Content-Length: 9\r\n\r\n{{{{{}}}}")] + (assert + (match (run [] (fls.io.read out)) + {:error {:code -32700} :jsonrpc "2.0"} + true + otherwise (values false (fennel.view otherwise))))))) + + ;; FIXME all of the other RPC codes + + (describe! "initialization" + ;; TODO get rid of hardcoded paths here + (it! "responds to initialize" + (local initialize + {:id 1 + :jsonrpc "2.0" + :method "initialize" + :params {:capabilities {} :clientInfo {:name "Neovim" :version "0.7.2"} :initializationOptions {} @@ -46,12 +60,28 @@ :trace "off" :workspaceFolders [{:name "/home/xerool/Documents/projects/fennel-ls" :uri "file:///home/xerool/Documents/projects/fennel-ls"}]}}) - (assert - (match (handle initialize-message) - {:id 1 - :jsonrpc "2.0" - :result {:capabilities {} - :serverInfo {:name "fennel-ls" : version}}} - true - otherwise (values false (view otherwise)))))) + (assert + (match (run [] initialize) + {:id 1 + :jsonrpc "2.0" + :result {:capabilities {} + :serverInfo {:name "fennel-ls" : version}}} + true + otherwise (values false (fennel.view otherwise)))))) + + (describe! "file syncing" + (it! "can open files from disk" + (local state (fls.state.new-state)) + (assert state) + (local uri + (-> (io.popen "pwd") + (: :read :*a) + (stringx.strip) + (->> (.. "file://")) + (.. "/test.fnl"))) + + (fls.state.add-file state uri) + (assert (. state :files uri)) + (assert.equal (. state :files uri :lines 1) + "(local fennel (require :fennel))"))))