Refactor

src/fennel-ls/compiler.fnl

@@ -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 -require- (sym :require))
-(local -fn- (fennel.sym :fn))
+(local -fn- (sym :fn))
-(local -λ- (fennel.sym :λ))
+(local -λ- (sym :λ))
-(local -lambda- (fennel.sym :lambda))
+(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)
+  (if (or (list? t)
-          (fennel.sequence? t))
+          (sequence? t))
     (ipairs t)
     (pairs t)))
 
@@ -31,10 +32,11 @@
 
 (λ 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))
-  (local references {})
+        definitions   {}
-  (local definitions-by-scope (doto {} (setmetatable has-tables-mt)))
+        diagnostics   {}
-  (local definitions {})
+        references    {}
+        require-calls {}]
 
     (λ find-definition [name ?scope]
       (when ?scope
@@ -43,7 +45,7 @@
 
     (λ reference [ast scope]
       ;; Add a reference to the references
-    (assert (fennel.sym? ast))
+      (assert (sym? ast))
       ;; find reference
       (let [name (string.match (tostring ast) "[^%.:]+")
             target (find-definition (tostring name) scope)]
@@ -55,7 +57,7 @@
       ;; 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)
+        (if (sym? binding)
             (let [definition
                   {: binding
                    : ?definition
@@ -75,9 +77,9 @@
       ;; add a function definition to the definitions
       (match ast
         (where [_fn name args]
-        (and (fennel.sym? name)
+          (and (sym? name)
                (not (multisym? name)) ;; not dealing with multisym for now
-             (fennel.sequence? args)))
+               (sequence? args)))
         (tset (. definitions-by-scope scope) ;; !!! TODO somehow insert into child scope
               (tostring name)
               {:binding name
@@ -109,31 +111,57 @@
         [-λ-]
         (define-function ast scope)
         [-lambda-]
-      (define-function ast scope)))
+        (define-function ast scope)
+        [-require- modname]
+        (tset require-calls ast true)))
 
-  (local plugin
+    (λ 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"))
+
+    ;; 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})
+        :destructure define
+        :assert-compile on-compiler-error}]
 
-  (local filename file.uri)
+      ;; ATTEMPT TO PARSE AST
-  (local ast
+      (match (pcall
-    (icollect [ok ast (fennel.parser file.text filename)]
+               #(icollect [ok ast (fennel.parser file.text file.uri {:plugins [plugin]})]
                   ast))
-
+        ;; ON SUCCESS
-  (local scope (fennel.scope))
+        (true ast)
+        (let [scope (fennel.scope)]
           (each [_i form (ipairs ast)]
-    (fennel.compile form
+            ;; COMPILE
-      {: filename
+            (match (pcall fennel.compile form {:filename file.uri : scope :plugins [plugin]})
-       : scope
+              (where (nil err) (not= err "__NOT_AN_ERROR"))
-       :plugins [plugin]}))
+              (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.references references)
-  (set file.definitions definitions)
       ;; (set file.definitions-by-scope definitions-by-scope) ;; not needed yet
-  (set file.ast ast))
+      (set file.definitions definitions)
+      (set file.diagnostics diagnostics)
+      (set file.references references)
+      (set file.require-calls require-calls))))
     ;; (set file.compiled? true))
 {: compile}

src/fennel-ls/handlers.fnl

@@ -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)
+  (match-try (language.find-symbol file.ast byte)
-    symbol
+    (symbol parents)
-    (match (language.search-main self file symbol)
+    (match-try
-      (result result-file) ;; curse you, magical match rules
+      (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))))
+      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)
+  (match-try (language.find-symbol file.ast byte)
-    symbol
+    symbol (language.search-main self file symbol)
-    (match (language.search-main self file symbol)
+    result {:contents {:kind "markdown"
-     result
+                       :value (formatter.hover-format 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?)
+  (state.set-uri-contents self uri (apply-changes file.text contentChanges))
-  (apply-changes (. self.files uri) 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))
 

src/fennel-ls/language.fnl

@@ -1,15 +1,12 @@
-(local fennel      (require :fennel))
+(local {: sym? : list? : sequence? : sym : view} (require :fennel))
-(local fennelutils (require :fennel.utils))
 (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 -require- (sym :require))
-(local list? fennel.list?)
+(local -dot- (sym :.))
-
+(local -do- (sym :do))
-(local -require- (fennel.sym :require))
-(local -dot- (fennel.sym :.))
 
 (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]
+  (match (. file.references symbol)
+    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
+             (. split i)))))) ;; TODO test coverage for this line
-  (match (. file.references symbol)
-    to (search-assignment self file to stack)))
 
 (λ 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))
+        (. split i)))
-      (search self file (. split 1) stack))))
+
+    ;; 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
+      (values ast [])
-      (or (not ?recursively-called)
+      (or (= 0 (length stack))
-          (fennel.list? ast)
+          (list? ast)
-          (fennel.sequence? 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))
+        (do
-      :else
+          (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
+        (do
-          (find-symbol k byte true)
+          (table.insert stack ast)
-          (find-symbol v byte true)))))
+          (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}

src/fennel-ls/message.fnl

@@ -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]
+(λ pos->range [sl sc el ec]
-  "if possible, returns the location of a symbol"
+  {:start {:line sl :character sc}
-  (match
+   :end   {:line el :character ec}})
-    (values
+
-      (utils.get-ast-info ?ast :bytestart)
+(λ 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}
+      (pos->range start-line start-col end-line end-col))))
-              :end   {:line end-line   :character end-col}}
+
-      :uri file.uri})))
+(λ 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}

src/fennel-ls/state.fnl

@@ -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,9 +43,10 @@
   (match (. self.files uri)
     ;; modify existing file
     file
+    (do
       (when (not= text file.text)
         (set file.text text)
-      (compile file)
+        (compile file))
       file)
 
     ;; create new file
@@ -57,7 +56,6 @@
       (compile file)
       file)))
 
-
 {: get-by-uri
  : get-by-module
  : set-uri-contents

test/diagnostic-test.fnl

@@ -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]}}]
+        ""))))

test/goto-definition-test.fnl

@@ -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))"
+  (it "works directly on a require/include (require XXX))"
-  ;;   (check :goto-definition.fnl 1 5 :bar.fnl 0 0 0 0)))
+     (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")

test/hover-test.fnl

@@ -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```"))

test/init.fnl

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

test/json-rpc-test.fnl

@@ -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))
 

test/lsp-test.fnl

@@ -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))

test/misc-test.fnl

@@ -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))

test/string-processing-test.fnl

@@ -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))

test/test-project/bar.fnl

@@ -1 +1 @@
-nil
+{}