rewrite diagnostics to support pull diagnostics

src/fennel-ls/analyzer.fnl

@@ -42,6 +42,7 @@ find the definition `10`, but if `opts.stop-early?` is set, it would find
 (local {: get-ast-info &as utils} (require :fennel-ls.utils))
 (local files (require :fennel-ls.files))
 (local docs (require :fennel-ls.docs))
+(local compiler (require :fennel-ls.compiler))
 
 (var search-multival nil) ;; all of the search functions are mutually recursive
 
@@ -142,6 +143,7 @@ find the definition `10`, but if `opts.stop-early?` is set, it would find
             (when (= :string (type mod))
               (let [newfile (files.get-by-module server mod file.macro-file?)]
                 (when newfile
+                  (compiler.compile server newfile)
                   (let [newitem (. newfile.ast (length newfile.ast))]
                     (when (= (length stack) 1)
                       (set opts.searched-through-require-with-stack-size-1 true))
@@ -267,9 +269,10 @@ initialization-opts: {:stack ?list[ast]
              byte
              (+ 1 (get-ast-info ?ast :byteend))))))
 
-(λ find-symbol [ast byte]
+(λ find-symbol [server file byte]
   "tries to find a sym, and a list of all of its parents/grandparents"
-  (local parents [ast])
+  (compiler.compile server file)
+  (local parents [file.ast])
   (λ recurse [ast]
     (if
       (sym? ast)
@@ -292,40 +295,34 @@ initialization-opts: {:stack ?list[ast]
                 (contains? value byte)
                 (recurse value)))))))
   (values
-    (accumulate [result nil _ top-level-form (ipairs ast) &until result]
+    (accumulate [result nil _ top-level-form (ipairs file.ast) &until result]
       (if (contains? top-level-form byte)
         (recurse top-level-form)))
     (fcollect [i 1 (length parents)]
       (. parents (- (length parents) i -1)))))
 
-(λ find-nearest-call [_server file byte]
+(λ find-nearest-call [server file byte]
   "Find the nearest call
 
 returns the called symbol and the number of the argument closest to byte"
-  (λ find-list [[call & parents]]
+  (case-try (find-symbol server file byte)
-    (if (. file.calls call)
+    (_symbol parents) (accumulate [result nil _ v (ipairs parents) &until result]
-        call
+                        (if (. file.calls v)
-        (next parents)
+                          v))
-        (find-list parents)))
+    [callee &as call] (values callee ;; TODO: special handling for binding forms so we can point to the
+                                     ;; individual arguments in an each or accumulate call.
+                                     ;; Also need to split them up in formatter.fnl
+                                     (faccumulate [index nil
+                                                   i (length call) 1 -1 &until index]
+                                       (if (contains? (. call i) byte)
+                                           ; -2 because this is the 3rd element of the list, but
+                                           ; the 2nd argument to the call, and LSP is 0-indexed
+                                           (- i 2)
+                                           (past? (. call i) byte)
+                                           ; this means we are either at the end of the list or
+                                           ; inserting between two arguments
+                                           (- i 1))))
 
-  (λ arg-index [call byte]
-    ;; TODO: special handling for binding forms so we can point to the
-    ;; individual arguments in an each or accumulate call.
-    ;; Also need to split them up in formatter.fnl
-    (faccumulate [index nil
-                  i (length call) 1 -1 &until index]
-      (if (contains? (. call i) byte)
-          ; -2 because this is the 3rd element of the list, but
-          ; the 2nd argument to the call, and LSP is 0-indexed
-          (- i 2)
-          (past? (. call i) byte)
-          ; this means we are either at the end of the list or
-          ; inserting between two arguments
-          (- i 1))))
-
-  (case-try (find-symbol file.ast byte)
-    (_symbol parents) (find-list parents)
-    [callee &as call] (values callee (arg-index call byte))
     (catch _ nil)))
 
 (λ find-definition [server file symbol ?byte]

src/fennel-ls/compiler.fnl

@@ -62,12 +62,12 @@ identifiers are declared / referenced in which places."
         position (utils.pos->position file.text line byte server.position-encoding)]
     {:start position :end position}))
 
-(λ compile [{:configuration {: macro-path} :root-uri ?root-uri &as server} file]
+(λ do-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"
   ;; The useful information being recorded:
   (let [definitions-by-scope (doto {} (setmetatable has-tables-mt))
         definitions   {} ; symbol -> binding
-        diagnostics   {} ; [diagnostic]
+        compile-diagnostics {} ; [diagnostic]
         references    {} ; symbol -> references
         macro-refs    {} ; symbol -> macro
         scopes        {} ; ast -> scope
@@ -307,7 +307,7 @@ identifiers are declared / referenced in which places."
     (λ on-compile-error [_ msg ast call-me-to-reset-the-compiler]
       (let [range (or (message.ast->range server file ast)
                       message.unknown-range)]
-        (table.insert diagnostics
+        (table.insert compile-diagnostics
           {:range range
            :message msg
            :severity message.severity.ERROR
@@ -321,7 +321,7 @@ identifiers are declared / referenced in which places."
     (λ on-parse-error [msg _filename line byte _source call-me-to-reset-the-compiler]
       (let [line (if (= line "?") 1 line)
             range (line+byte->range server file line byte)]
-        (table.insert diagnostics
+        (table.insert compile-diagnostics
           {:range range
            :message msg
            :severity message.severity.ERROR
@@ -334,7 +334,7 @@ identifiers are declared / referenced in which places."
 
     (λ warn [msg ?ast _file ?line ?col]
       (let [range (or (message.ast->range server file ?ast) (line+byte->range server file (or ?line 1) (or ?col 0)))]
-        (table.insert diagnostics
+        (table.insert compile-diagnostics
           {:range range
            :message msg
            :severity message.severity.WARN
@@ -380,7 +380,7 @@ identifiers are declared / referenced in which places."
                             (if (os.getenv :DEV)
                               (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"))
-                              (table.insert diagnostics
+                              (table.insert compile-diagnostics
                                 {:range (line+byte->range server file 1 1)
                                  :message (.. "unrecoverable " component " error: " err)}))))
 
@@ -434,7 +434,7 @@ identifiers are declared / referenced in which places."
                                     (fn hook []
                                       (debug.sethook nil nil)
                                       (if _G.jit (_G.jit.on))
-                                      (table.insert diagnostics
+                                      (table.insert compile-diagnostics
                                         {:range message.unknown-range
                                          :message "instruction limit reached"
                                          :severity message.severity.ERROR})
@@ -459,11 +459,15 @@ identifiers are declared / referenced in which places."
       (set file.scopes scopes)
       (set file.definitions definitions)
       (set file.definitions-by-scope definitions-by-scope)
-      (set file.diagnostics diagnostics)
+      (set file.compile-errors compile-diagnostics)
       (set file.references references)
       (set file.require-calls require-calls)
       (set file.allowed-globals allowed-globals)
       (set file.macro-refs macro-refs)
       (set file.macro-calls macro-calls))))
 
+(fn compile [server file]
+  (when (not file.ast)
+    (do-compile server file)))
+
 {: compile}

src/fennel-ls/completion.fnl

@@ -25,8 +25,9 @@ actually recover the original completion. If the client supports both
 CompletionClientCapabilites.completionList.itemDefaults.editRange and
 CompletionClientCapabilites.completionList.itemDefaults.data, then we can ask
 the client to forward information to the resolve request by setting the `data`
-to {: uri : byte}. When this capability exists, `server.can-do-good-completions?`
+to {: uri : byte}. When this capability exists,
-is set to true and we report that we support completionItem/resolve."
+`server.client-capable-of-good-completions?` is set to true and we report that
+we support completionItem/resolve."
 
 (local fennel (require :fennel))
 (local {:metadata METADATA} (require :fennel.compiler))
@@ -49,7 +50,7 @@ is set to true and we report that we support completionItem/resolve."
         file {:text (.. (file.text:sub 1 (- byte 1)) "|" (file.text:sub byte)) :uri file.uri}
         _ (compiler.compile server file)
         ;; find what ast objects are under the cursor
-        (symbol parents) (analyzer.find-symbol file.ast byte)
+        (symbol parents) (analyzer.find-symbol server file byte)
         ;; check what context I'm in
         in-call-position? (or (and (fennel.list? (. parents 1))
                                    (= symbol (. parents 1 1)))
@@ -136,7 +137,7 @@ is set to true and we report that we support completionItem/resolve."
 
     (fn binding-completions []
       "completions when you're writing a destructure pattern. We suggest identifiers which are unknown"
-      (each [_ {: message} (ipairs file.diagnostics)]
+      (each [_ {: message} (ipairs file.compile-errors)]
         (case (message:match "unknown identifier: ([a-zA-Z0-9_-]+)")
           identifier (add-completion! identifier {} :Variable))))
 
@@ -145,8 +146,8 @@ is set to true and we report that we support completionItem/resolve."
           (binding-completions)
           (expression-completions)))
 
-    (if server.can-do-good-completions?
+    (if server.client-capable-of-good-completions?
-      {:itemDefaults {:editRange (if server.can-do-insert-replace-completions?
+      {:itemDefaults {:editRange (if server.client-capable-of-insert-replace-completions?
                                      {:insert {:start range.start :end position}
                                       :replace range}
                                      range)
@@ -157,7 +158,7 @@ is set to true and we report that we support completionItem/resolve."
 (fn completionItem/resolve [server _send completion-item]
   (let [{: uri : byte} completion-item.data
         file (files.get-by-uri server uri)
-        (_symbol parents) (analyzer.find-symbol file.ast byte)
+        (_symbol parents) (analyzer.find-symbol server file byte)
         scope (or (. file.scopes _symbol)
                   (accumulate [?find nil _ parent (ipairs parents) &until ?find]
                     (. file.scopes parent))

src/fennel-ls/config.fnl

@@ -126,13 +126,15 @@ However, when not an option, fennel-ls will fall back to positionEncoding=\"utf-
   (set server.macro-modules {})
   (set server.root-uri params.rootUri)
   (set server.position-encoding (choose-position-encoding params))
-  (set server.can-do-good-completions?
+  (set server.client-capable-of-good-completions?
        ;; if client supports CompletionClientCapabilites.completionList.itemDefaults.editRange
        ;;                and CompletionClientCapabilites.completionList.itemDefaults.data
        (case (?. params :capabilities :textDocument :completion :completionList :itemDefaults)
           completion-item-defaults  (and (accumulate [found nil _ v (ipairs completion-item-defaults) &until found] (= v :editRange))
                                          (accumulate [found nil _ v (ipairs completion-item-defaults) &until found] (= v :data)))))
-  (set server.can-do-insert-replace-completions? (?. params :capabilities :textDocument :completion :completionItem :insertReplaceSupport))
+  (set server.client-capable-of-insert-replace-completions? (?. params :capabilities :textDocument :completion :completionItem :insertReplaceSupport))
+  (set server.client-capable-of-pull-diagnostics? (or (?. params :capabilities :textDocument :diagnostic)
+                                                      (not (?. params :capabilities :textDocument :publishDiagnostics))))
   (reload server))
 
 {: initialize

src/fennel-ls/files.fnl

@@ -3,7 +3,6 @@ This module has high level helpers for creating/getting \"file\" objects."
 
 (local searcher (require :fennel-ls.searcher))
 (local utils (require :fennel-ls.utils))
-(local {: compile} (require :fennel-ls.compiler))
 
 (λ read-file [server uri]
   ;; preload is here so that tests can inject files
@@ -23,7 +22,6 @@ This module has high level helpers for creating/getting \"file\" objects."
   (or (. server.files uri)
       (case (read-file server uri)
         file (do
-               (compile server file)
                (tset server.files uri file)
                file))))
 
@@ -44,21 +42,9 @@ This module has high level helpers for creating/getting \"file\" objects."
           (get-by-uri server uri))))))
 
 (λ set-uri-contents [server uri text]
-  (case (. server.files uri)
+  (let [file {: uri : text}]
-    ;; modify existing file
+    (tset server.files uri file)
-    file
+    file))
-    (do
-      (when (not= text file.text)
-        (set file.text text)
-        (compile server file))
-      file)
-
-    ;; create new file
-    nil
-    (let [file {: uri : text}]
-      (tset server.files uri file)
-      (compile server file)
-      file)))
 
 (λ flush-uri [server uri]
   "get rid of data about a file, in case it changed in some way"

src/fennel-ls/formatter.fnl

@@ -209,9 +209,9 @@ fntype is one of fn or λ or lambda"
                    metadata (?. kinds metadata.fls/itemKind))
                  (if (name:find "%.") kinds.Field kinds.Value))]
     {:label name
-     :documentation (when (not server.can-do-good-completions?) (hover-format server name definition))
+     :documentation (when (not server.client-capable-of-good-completions?) (hover-format server name definition))
      :sortText (sort-text name kind)
-     :textEdit (when (not server.can-do-good-completions?) {:newText name : range})
+     :textEdit (when (not server.client-capable-of-good-completions?) {:newText name : range})
      : kind}))
 
 {: signature-help-format

src/fennel-ls/handlers.fnl

@@ -26,7 +26,7 @@ Every time the client sends a message, it gets handled by a function in the corr
                             :save true}
          ;; :notebookDocumentSync nil
          :completionProvider {:workDoneProgress false
-                              :resolveProvider server.can-do-good-completions?
+                              :resolveProvider server.client-capable-of-good-completions?
                               :triggerCharacters ["(" "[" "{"
                                                   ;; The LSP spec claims that "characters that make up identifiers don't need to be listed here"
                                                   ;; > https://github.com/microsoft/language-server-protocol/blob/4a4ff53db00d8c5e57630ff364dedf1918cbb612/_specifications/lsp/3.18/language/completion.md?plain=1#L205
@@ -51,7 +51,7 @@ Every time the client sends a message, it gets handled by a function in the corr
          ;; :documentFormattingProvider {:workDoneProgress false}
          ;; :documentRangeFormattingProvider nil
          ;; :documentOnTypeFormattingProvider nil
-         :renameProvider {:workDoneProgress false}}]
+         :renameProvider {:workDoneProgress false}
          ;; :foldingRangeProvider nil
          ;; :executeCommandProvider nil
          ;; :selectionRangeProvider nil
@@ -62,8 +62,7 @@ Every time the client sends a message, it gets handled by a function in the corr
          ;; :typeHierarchyProvider nil
          ;; :inlineValueProvider nil
          ;; :inlayHintProvider nil
-         ;; ;; this is for PULL diagnostics, but fennel-ls currently does PUSH diagnostics
+         :diagnosticProvider {:workDoneProgress false}}]
-         ;; :diagnosticProvider {:workDoneProgress false}})
          ;; :workspaceSymbolProvider nil
          ;; :workspace {:workspaceFolders nil
          ;;             :fileOperations {:didCreate nil
@@ -79,7 +78,7 @@ Every time the client sends a message, it gets handled by a function in the corr
 (λ requests.textDocument/definition [server _send {: position :textDocument {: uri}}]
   (let [file (files.get-by-uri server uri)
         byte (utils.position->byte file.text position server.position-encoding)]
-    (case-try (analyzer.find-symbol file.ast byte)
+    (case-try (analyzer.find-symbol server file byte)
       (symbol [parent])
       (let [search-target (if (. file.require-calls parent) parent symbol)]
         (analyzer.search server file search-target {:stop-early? true} {: byte}))
@@ -95,7 +94,7 @@ Every time the client sends a message, it gets handled by a function in the corr
                                                           :textDocument {: uri}}]
   (let [this-file (files.get-by-uri server uri)
         byte (utils.position->byte this-file.text position server.position-encoding)]
-    (match-try (analyzer.find-symbol this-file.ast byte)
+    (match-try (analyzer.find-symbol server this-file byte)
       symbol
       (analyzer.find-nearest-definition server this-file symbol byte)
       {: referenced-by :file {:uri this-file.uri &as file} : binding}
@@ -113,7 +112,7 @@ Every time the client sends a message, it gets handled by a function in the corr
                                                              include-declaration?}}]
   (let [file (files.get-by-uri server uri)
         byte (utils.position->byte file.text position server.position-encoding)]
-    (case-try (analyzer.find-symbol file.ast byte)
+    (case-try (analyzer.find-symbol server file byte)
       symbol
       (analyzer.find-nearest-definition server file symbol byte)
       {: referenced-by : file : binding}
@@ -146,7 +145,7 @@ Every time the client sends a message, it gets handled by a function in the corr
 (λ requests.textDocument/hover [server _send {: position :textDocument {: uri}}]
   (let [file (files.get-by-uri server uri)
         byte (utils.position->byte file.text position server.position-encoding)]
-    (case-try (analyzer.find-symbol file.ast byte)
+    (case-try (analyzer.find-symbol server file byte)
       (symbol parents) (analyzer.search server file symbol {} {: byte})
       {:indeterminate nil &as result}
       (let [opts {:macroexpansion (case-try parents
@@ -166,7 +165,7 @@ Every time the client sends a message, it gets handled by a function in the corr
 (λ requests.textDocument/rename [server _send {: position :textDocument {: uri} :newName new-name}]
   (let [file (files.get-by-uri server uri)
         byte (utils.position->byte file.text position server.position-encoding)]
-    (case-try (analyzer.find-symbol file.ast byte)
+    (case-try (analyzer.find-symbol server file byte)
       symbol
       (analyzer.find-nearest-definition server file symbol symbol.bytestart)
       ;; TODO we are assuming that every reference is in the same file
@@ -206,7 +205,8 @@ Every time the client sends a message, it gets handled by a function in the corr
   (let [file (files.get-by-uri server uri)
         byte (utils.position->byte file.text range.start server.position-encoding)
         results []]
-    (case-try (analyzer.find-symbol file.ast byte)
+    (lint.add-lint-diagnostics server file)
+    (case-try (analyzer.find-symbol server file byte)
       (symbol_ [[symbol_ &as parent]]) file.macro-calls
       {parent expansion} (table.insert results
                            {:title "Expand macro"
@@ -216,16 +216,25 @@ Every time the client sends a message, it gets handled by a function in the corr
       (if (overlap? diagnostic.range range)
         (message.diagnostic->code-action server file diagnostic :quickfix)))))
 
+(λ requests.textDocument/diagnostic [server _send {:textDocument {: uri}}]
+  (let [file (files.get-by-uri server uri)]
+    (lint.add-lint-diagnostics server file)
+    {:kind "full"
+     :items file.diagnostics}))
+
+(fn push-diagnostics [server file send]
+  (when (not server.client-capable-of-pull-diagnostics?)
+    (lint.add-lint-diagnostics server file)
+    (send (message.diagnostics file))))
+
 (λ notifications.textDocument/didChange [server send {: contentChanges :textDocument {: uri}}]
   (local file (files.get-by-uri server uri))
   (files.set-uri-contents server uri (utils.apply-changes file.text contentChanges server.position-encoding))
-  (lint.add-lint-diagnostics server file)
+  (push-diagnostics server file send))
-  (send (message.diagnostics file)))
 
 (λ notifications.textDocument/didOpen [server send {:textDocument {: text : uri}}]
   (local file (files.set-uri-contents server uri text))
-  (lint.add-lint-diagnostics server file)
+  (push-diagnostics server file send)
-  (send (message.diagnostics file))
   (set file.open? true))
 
 (λ notifications.textDocument/didSave [server _send {:textDocument {: uri}}]

src/fennel-ls/lint.fnl

@@ -14,6 +14,7 @@ You can read more about how to add lints in docs/linting.md"
 (local navigate (require :fennel-ls.navigate))
 (local docs (require :fennel-ls.docs))
 (local dkjson (require :dkjson))
+(local compiler (require :fennel-ls.compiler))
 
 
 (fn special? [item]
@@ -855,30 +856,33 @@ You can read more about how to add lints in docs/linting.md"
     (setmetatable {: self : fix} lint-mt)))
 
 (λ add-lint-diagnostics [server file]
-  (fn run [lints ...]
+  (when (not file.diagnostics)
-    (each [_ lint (ipairs lints)]
+    (compiler.compile server file)
-      (when (. server.configuration.lints lint.name)
+    (set file.diagnostics file.compile-errors)
-        (case (lint.impl ...)
+    (fn run [lints ...]
-          diagnostic
+      (each [_ lint (ipairs lints)]
-          (table.insert file.diagnostics
+        (when (. server.configuration.lints lint.name)
-            (wrap (doto diagnostic
+          (case (lint.impl ...)
-                        (tset :code lint.name))))))))
+            diagnostic
-  (icollect [diagnostic (coroutine.wrap #(run lints.other server file)) &into file.diagnostics]
+            (table.insert file.diagnostics
-    (wrap diagnostic))
+              (wrap (doto diagnostic
-  (each [symbol definition (pairs file.definitions)]
+                          (tset :code lint.name))))))))
-    (when (. file.lexical symbol)
+    (icollect [diagnostic (coroutine.wrap #(run lints.other server file)) &into file.diagnostics]
-      (run lints.definition server file symbol definition)))
+      (wrap diagnostic))
-  (each [symbol (pairs file.references)]
+    (each [symbol definition (pairs file.definitions)]
-    (when (. file.lexical symbol)
+      (when (. file.lexical symbol)
-      (run lints.reference server file symbol)))
+        (run lints.definition server file symbol definition)))
-  (each [[head &as ast] (pairs file.calls)]
+    (each [symbol (pairs file.references)]
-    (when (and (. file.lexical ast) (not= nil head))
+      (when (. file.lexical symbol)
-      (run (if (special? head) lints.special-call lints.function-call)
+        (run lints.reference server file symbol)))
-          server file ast)))
+    (each [[head &as ast] (pairs file.calls)]
-  (each [ast macroexpanded (pairs file.macro-calls)]
+      (when (and (. file.lexical ast) (not= nil head))
-    (when (. file.lexical ast)
+        (run (if (special? head) lints.special-call lints.function-call)
-      (run lints.macro-call
+            server file ast)))
-           server file ast macroexpanded))))
+    (each [ast macroexpanded (pairs file.macro-calls)]
+      (when (. file.lexical ast)
+        (run lints.macro-call
+             server file ast macroexpanded)))))
 
 {: add-lint-diagnostics
  :list all-lints}

test/diagnostic.fnl

@@ -21,7 +21,8 @@
       i)))
 
 (fn check [file-contents expected unexpected ?opts]
-  (let [{: diagnostics} (create-client file-contents nil ?opts)]
+  (let [{: uri : client} (create-client file-contents nil ?opts)
+        [{:result {:items diagnostics}}] (client:diagnostic uri)]
     (each [_ e (ipairs unexpected)]
       (let [i (find diagnostics e)]
         (faith.= nil i (.. "Lint matching " (view e) "\n"

test/lint.fnl

@@ -22,7 +22,8 @@
          i))))
 
 (fn check [file-contents expected ?unexpected]
-  (let [{: diagnostics} (create-client file-contents)]
+  (let [{: uri : client} (create-client file-contents)
+        [{:result {:items diagnostics}}] (client:diagnostic uri)]
     (each [_ e (ipairs (or ?unexpected []))]
       (let [i (find diagnostics e)]
         (faith.= nil i (.. "Lint matching " (view e) "\n"
@@ -38,7 +39,8 @@
         (table.remove diagnostics i)))))
 
 (fn assert-ok [file-contents]
-  (let [{: diagnostics} (create-client file-contents)]
+  (let [{: uri : client} (create-client file-contents)
+        [{:result {:items diagnostics}}] (client:diagnostic uri)]
     (faith.= nil (next diagnostics) (view diagnostics))))
 
 (fn test-unused []

test/misc.fnl

@@ -19,7 +19,7 @@
 (fn test-find-symbol []
   (let [{: server : uri} (create-client "(match [1 2 4] [1 2 sym-one] sym-one)")
         file (. server.files uri)
-        (symbol parents) (analyzer.find-symbol file.ast 23)]
+        (symbol parents) (analyzer.find-symbol server file 23)]
     (faith.= symbol (fennel.sym :sym-one))
     (faith.=
       "[[1 2 sym-one] (match [1 2 4] [1 2 sym-one] sym-one) [(match [1 2 4] [1 2 sym-one] sym-one)]]"
@@ -28,7 +28,7 @@
 
   (let [{: server : uri} (create-client "(match [1 2 4] [1 2 sym-one] sym-one)")
         file (. server.files uri)
-        (symbol parents) (analyzer.find-symbol file.ast 18)]
+        (symbol parents) (analyzer.find-symbol server file 18)]
     (faith.= symbol nil)
     (faith.=
       "[[1 2 sym-one] (match [1 2 4] [1 2 sym-one] sym-one) [(match [1 2 4] [1 2 sym-one] sym-one)]]"

test/settings.fnl

@@ -12,6 +12,10 @@
     (faith.= location response.result
       "error message")))
 
+(fn get-diagnostics [file-contents]
+  (let [{: uri : client} (create-client file-contents)]
+    (. (client:diagnostic uri) 1 :result :items)))
+
   ;; TODO fix macros to use a custom searcher
   ; (let [{: diagnostics}
   ;       (create-client
@@ -29,10 +33,10 @@
   ;;   (local client (doto [] ({:settings {:fennel-ls {:fennel-path "./?/?/?/?.fnl"}}))))
 
 (fn test-extra-globals []
-  (let [{:diagnostics good} (create-client {:main.fnl "(foo-100 bar :baz)"
+  (let [good (get-diagnostics {:main.fnl "(foo-100 bar :baz)"
-                                            :flsproject.fnl "{:extra-globals \"foo-100 bar\"}"})
+                               :flsproject.fnl "{:extra-globals \"foo-100 bar\"}"})
-        {:diagnostics bad} (create-client {:main.fnl "(foo-100 bar :baz)"
+        bad (get-diagnostics {:main.fnl "(foo-100 bar :baz)"
-                                           :flsproject.fnl "{}"})]
+                              :flsproject.fnl "{}"})]
     (faith.= [] good)
     (faith.not= [] bad))
   nil)
@@ -44,10 +48,10 @@
   ;;   (local client (doto [] (setup-server {:fennel-ls {:diagnostics {:E202 "warning"}}})))))
 
 (fn test-lints []
-  (let [{:diagnostics good} (create-client {:main.fnl "(local x 10)"
+  (let [good (get-diagnostics {:main.fnl "(local x 10)"
-                                            :flsproject.fnl "{:lints {:unused-definition false}}"})
+                               :flsproject.fnl "{:lints {:unused-definition false}}"})
-        {:diagnostics bad} (create-client {:main.fnl "(local x 10)"
+        bad (get-diagnostics {:main.fnl "(local x 10)"
-                                           :flsproject.fnl "{}"})]
+                              :flsproject.fnl "{}"})]
     (faith.= [] good)
     (faith.not= [] bad))
   nil)
@@ -76,20 +80,20 @@
     (faith.match "Could not find docset for library nasilemak"
                  show.params.message)
     ;; diagnostic
-    (let [[diagnostics] (client:open-file! (.. client.server.root-uri "/" :flsproject.fnl) "{:libraries {:nasilemak true}}")]
+    (client:open-file! (.. client.server.root-uri "/" :flsproject.fnl) "{:libraries {:nasilemak true}}")
-      (faith.= "textDocument/publishDiagnostics" diagnostics.method)
+    (let [[diagnostics] (client:diagnostic (.. client.server.root-uri "/" :flsproject.fnl))]
-      (faith.match "Could not find docset for library nasilemak" (. diagnostics.params.diagnostics 1 :message))))
+      (faith.match "Could not find docset for library nasilemak" (. diagnostics.result.items 1 :message))))
   nil)
 
 (fn test-infinite-macro []
   (when (not debug.debug)
     (faith.skip))
-  (let [{: diagnostics} (create-client {:main.fnl "(macro infinite [] (while true nil))\n(infinite)\n"
+  (let [diagnostics (get-diagnostics {:main.fnl "(macro infinite [] (while true nil))\n(infinite)\n"
-                                        :flsproject.fnl "{:compiler-instruction-limit 25000}"})]
+                                      :flsproject.fnl "{:compiler-instruction-limit 25000}"})]
     (faith.= "instruction limit reached"
              (?. diagnostics 1 :message)))
-  (let [{: diagnostics} (create-client {:main.fnl "(macro finite [] (while false nil))\n(finite)\n"
+  (let [diagnostics (get-diagnostics {:main.fnl "(macro finite [] (while false nil))\n(finite)\n"
-                                        :flsproject.fnl "{:compiler-instruction-limit 25000}"})]
+                                      :flsproject.fnl "{:compiler-instruction-limit 25000}"})]
     (faith.= [] diagnostics))
   nil)
     

test/utils/client.fnl

@@ -75,6 +75,14 @@
       :textDocument {:uri file}
       : newName})))
 
+(fn diagnostic [self file ?previousResultId]
+  (dispatch.handle* self.server
+    (message.create-request (next-id! self) :textDocument/diagnostic
+     (let [params {:textDocument {:uri file}}]
+       (when ?previousResultId
+         (set params.previousResultId ?previousResultId))
+       params))))
+
 (fn code-action [self file range]
   (dispatch.handle* self.server
     (message.create-request (next-id! self) :textDocument/codeAction
@@ -100,6 +108,7 @@
              : signature-help
              : rename
              : code-action
+             : diagnostic
              : did-save}})
 
 {: client-mt

test/utils/init.fnl

@@ -89,10 +89,10 @@
                                  : params})
           _     (each [k v (pairs (or ?config []))]
                   (tset server.configuration k v))
-          [{:params {: diagnostics}}] (client:open-file! uri text)]
+          ?diagnostics (?. (client:open-file! uri text) 1 :params :diagnostics)]
         {: client
          : server
-         : diagnostics
+         :diagnostics ?diagnostics
          : cursor
          : locations
          : highlights