Options over LSP

Fennel-ls now can receive options from the language client over the
protocol. Future work still necessary to have project-local files.

src/fennel-ls/compiler.fnl

@@ -122,7 +122,8 @@ later by fennel-ls.language to answer requests from the client."
       (local args
         (case ast
           (where [_fn args] (fennel.sequence? args)) args
-          (where [_fn _name args] (fennel.sequence? args)) args))
+          (where [_fn _name args] (fennel.sequence? args)) args
+          _ []))
       (each [_ argument (ipairs args)]
         (define (sym :nil) argument scope))) ;; we say function arguments are set to nil
 
@@ -213,10 +214,10 @@ later by fennel-ls.language to answer requests from the client."
           ast (icollect [ok ok-2 ast parser &until (not (and ok ok-2))] ast)]
       ;; compile
       (each [_i form (ipairs (if macro-file? (ast->macro-ast ast) ast))]
-        (case (pcall fennel.compile form opts)
+        (case (xpcall #(fennel.compile form opts) fennel.traceback)
-          (where (or (nil err) (false err)) (not (err:find "__NOT_AN_ERROR\n?$")))
+          (where (or (nil err) (false err)) (not (err:find "^[^\n]-__NOT_AN_ERROR\n")))
-          (error (.. "\nyou have crashed the compiler with the message:" err
+          (error (.. "\nYou have crashed the fennel compiler or fennel-ls with the following message\n:" err
-                     "\nI am considering supressing this error if I get a lot of false alarms"))))
+                     "\n\n^^^ the error message above here is the root problem\n\n"))))
           ; (table.insert diagnostics
           ;   {:range (message.pos->range 0 0 0 0)
           ;    :message (.. "unrecoverable compiler error: " err)})
@@ -233,7 +234,8 @@ later by fennel-ls.language to answer requests from the client."
       ;     ;; base case???
 
       (each [sym definition (pairs definitions)]
-          (if (and (= 0 (length definition.referenced-by))
+          (if (and self.configuration.checks.unused-definition
+                   (= 0 (length definition.referenced-by))
                    (not= "_" (: (tostring sym) :sub 1 1)))
             (let [range (message.ast->range sym file)]
               (table.insert diagnostics
@@ -243,7 +245,6 @@ later by fennel-ls.language to answer requests from the client."
                  :code 301
                  :codeDescription "warning error"}))))
 
-
       (set file.ast ast)
       (set file.scope scope)
       (set file.scopes scopes)

src/fennel-ls/handlers.fnl

@@ -180,8 +180,8 @@ Every time the client sends a message, it gets handled by a function in the corr
   ;; TODO only reload from disk if we didn't get a didSave, instead of always
   (state.flush-uri self uri))
 
-(λ notifications.workspace/didChangeConfiguration [self send params]
+(λ notifications.workspace/didChangeConfiguration [self send {: settings}]
-  (state.write-config self params.fennel-ls))
+  (state.write-configuration self settings.fennel-ls))
 
 (λ requests.shutdown [self send]
   "The server still needs to respond to this request, so the program can't close yet. Just wait until notifications.exit"

src/fennel-ls/searcher.fnl

@@ -35,7 +35,7 @@ I suspect this file may be gone after a bit of refactoring."
           (table.insert result (join (utils.uri->path workspace) path)))))
     (table.concat result ";")))
 
-(λ lookup [{:config {: fennel-path} : root-uri} mod]
+(λ lookup [{:configuration {: fennel-path} : root-uri} mod]
   (match (or ;; TODO support lua ;; (fennel.searchModule mod (add-workspaces-to-path luapath [root-uri]))
              (fennel.searchModule mod (add-workspaces-to-path fennel-path [root-uri])))
     modname (utils.path->uri modname)

src/fennel-ls/state.fnl

@@ -60,11 +60,6 @@ object."
   "get rid of data about a file, in case it changed in some way"
   (tset self.files uri nil))
 
-(local default-config
-  {:fennel-path "./?.fnl;./?/init.fnl;src/?.fnl;src/?/init.fnl"
-   :macro-path  "./?.fnl;./?/init-macros.fnl;./?/init.fnl;src/?.fnl;src/?/init-macros.fnl;src/?/init.fnl"
-   :globals     ""})
-
 ;; TODO: set the warning levels of lints
 ;; allow all globals
 ;; allow some globals
@@ -74,32 +69,48 @@ object."
 ;; make a "compat strict" mode that warns about any lua-version-specific patterns
 ;; ie using (unpack) without saying (or table.unpack _G.unpack) or something like that
 
-(λ write-config [self ?config]
+(local option-mt {})
-  (if (not ?config)
+(fn option [default-value]
-    (set self.config default-config) ;; fast path, use all defaults
+  "represents an \"option\" that the user can override"
-    (set self.config
+  (doto [default-value] (setmetatable option-mt)))
-      {;; fennel-path:
+
-       ;; the path to use to find fennel files using (require) or (include)
+(fn make-configuration-from-template [default ?user ?parent]
-       :fennel-path (or ?config.fennel-path
+  (if (= option-mt (getmetatable default))
-                        default-config.fennel-path)
+      (let [setting
-       ;; macro-path:
+             (match-try ?user
-       ;; the path to use to find fennel files using (require-macros) or (include-macros)
+               nil (?. ?parent :all)
-       :macro-path (or ?config.macro-path
+               nil (. default 1))]
-                       default-config.fennel-path)
+        (assert (= (type (. default 1)) (type setting)))
-       ;; globals:
+        setting)
-       ;; Comma separated list of extra globals that are allowed.
+      (= :table (type default))
-       :globals (or ?config.globals
+      (collect [k v (pairs default)]
-                    default-config.globals)})))
+          k (make-configuration-from-template
+              (. default k)
+              (?. ?user k)
+              ?user))
+      (error "This is a bug with fennel-ls: default-configuration has a key that isn't a table or option")))
+
+(local default-configuration
+  {:fennel-path (option "./?.fnl;./?/init.fnl;src/?.fnl;src/?/init.fnl")
+   :macro-path (option "./?.fnl;./?/init-macros.fnl;./?/init.fnl;src/?.fnl;src/?/init-macros.fnl;src/?/init.fnl")
+   :checks {:unused-definition (option true)}})
+
+(λ make-configuration [?c]
+  (make-configuration-from-template default-configuration ?c))
 
 (λ init-state [self params]
   (set self.files {})
   (set self.modules {})
   (set self.root-uri params.rootUri)
-  (write-config self))
+  (set self.configuration (make-configuration)))
+
+(λ write-configuration [self ?configuration]
+  (set self.configuration (make-configuration ?configuration)))
+
 
 {: flush-uri
  : get-by-module
  : get-by-uri
  : init-state
  : set-uri-contents
- : write-config}
+ : write-configuration}

test/diagnostic-test.fnl

@@ -28,12 +28,14 @@
           diagnostic
           (match responses
             [{:params {: diagnostics}}]
-            (find [i v (ipairs diagnostics)]
+            (is (find [i v (ipairs diagnostics)]
-               (match v
+                  (match v
-                 {:message "tried to reference a special form without calling it"
+                    {:message "tried to reference a special form without calling it"
-                  :range {:start {:character 4 :line 0}
+                     :range {:start {:character 4 :line 0}
-                          :end   {:character 6 :line 0}}}
+                             :end   {:character 6 :line 0}}}
-                 v)))]
+                    v))
+                "not found")
+            _ (error "did not match"))]
       (is diagnostic "expected a diagnostic")))
 
   (it "handles parse errors"
@@ -42,12 +44,14 @@
           diagnostic
           (match responses
             [{:params {: diagnostics}}]
-            (find [i v (ipairs diagnostics)]
+            (is (find [i v (ipairs diagnostics)]
-             (match v
+                 (match v
-               {:message "expected whitespace before opening delimiter ("
+                   {:message "expected whitespace before opening delimiter ("
-                :range {:start {:character 17 :line 0}
+                    :range {:start {:character 17 :line 0}
-                        :end   {:character 17 :line 0}}}
+                            :end   {:character 17 :line 0}}}
-               v)))]
+                   v))
+                "not found")
+            _ (error "did not match"))]
       (is diagnostic "expected a diagnostic")))
 
   (it "handles (match)"
@@ -64,7 +68,21 @@
     (let [self (create-client)
           responses (self:open-file! filename "(unknown-global-1 unknown-global-2)")]
       (is-matching responses
-        [{:params {:diagnostics [a b]}}]  "there should be a diagnostic for each one here"))))
+        [{:params {:diagnostics [a b]}}]  "there should be a diagnostic for each one here")))
+
+  (it "warns about unused variables"
+    (let [self (create-client)
+          responses (self:open-file! filename "(local x 10)")]
+      (match responses
+        [{:params {: diagnostics}}]
+        (is (find [i v (ipairs diagnostics)]
+             (match v
+               {:message "unused definition: x"
+                :range {:start {:character 7 :line 0}
+                        :end   {:character 8 :line 0}}}
+               v))
+            "not found")
+        _ (error "did not match")))))
 
 ;; TODO lints:
 ;; unnecessary (do) in body position

test/misc-test.fnl

@@ -55,4 +55,7 @@
   (it "doesn't crash"
     (let [self (create-client)
           state (require :fennel-ls.state)]
-      (state.get-by-module self.server "test.test-project.crash-files.test"))))
+      (state.get-by-module self.server "test.test-project.crash-files.test")))
+  (it "doesn't crash 2"
+    (doto (create-client)
+      (: :open-file! filename "(macro foo {})"))))

test/mock-client.fnl

@@ -31,7 +31,7 @@
     (if ?config
       (dispatch.handle* self.server {:jsonrpc "2.0"
                                      :method :workspace/didChangeConfiguration
-                                     :params ?config}))
+                                     :params {:settings ?config}}))
     self))
 
 (fn next-id! [self]

test/settings-test.fnl

@@ -1,39 +1,48 @@
 (import-macros {: is-matching : describe : it : before-each} :test)
 (local is (require :test.is))
 
-(local {: view} (require :fennel))
 (local {: ROOT-URI
         : create-client} (require :test.mock-client))
 
-(local dispatch (require :fennel-ls.dispatch))
-(local message (require :fennel-ls.message))
-
 (describe "settings"
   (it "can set the path"
     (let [client (doto (create-client {:fennel-ls {:fennel-path "./?/?.fnl"}})
                    (: :open-file! (.. ROOT-URI :/test.fnl) "(local {: this-is-in-modname} (require :modname))"))
-          [{:result {:range message}}]
+          result (client:definition (.. ROOT-URI :/test.fnl) 0 12)]
-          (client:definition (.. ROOT-URI :/test.fnl) 0 12)]
+      (eval-compiler
-      (is.not.nil message)
+        (print "EVAL" (in-scope? (sym :message))))
-      "body")))
+      (is-matching
+        result
+        [{:result {:range message}}]
+        "error message")))
 
   ;; (it "can set the path"
-  ;;   (local self (doto [] (setup-server {:fennel-ls {:macro-path "./?/?.fnl"}}))))
+  ;;   (let [client (doto (create-client {:fennel-ls {:macro-path "./?/?.fnl"}})
+  ;;                  (: :open-file! (.. ROOT-URI :/test.fnl) "(import-macros {: this-is-in-modname} :modname)"))]
+  ;;     (is-matching
+  ;;         (client:definition (.. ROOT-URI :/test.fnl) 0 12)
+  ;;         [{:result {:range message}}]))))
 
   ;; (it "can infer the macro path from fennel-path"
   ;;   (local self (doto [] (setup-server {:fennel-ls {:fennel-path "./?/?.fnl"}}))))
 
   ;; (it "can accept an allowed global"
-  ;;   (local self (doto [] (setup-server {:fennel-ls {:globals "vim"}}))))
+  ;;   (local self (doto [] (setup-server {:fennel-ls {:extra-globals "vim"}}))))
 
   ;; (it "can accept a list of allowed globals"
-  ;;   (local self (doto [] (setup-server {:fennel-ls {:globals "GAMESTATE,SCREEN_CENTER_X,ETC"}}))))
+  ;;   (local self (doto [] (setup-server {:fennel-ls {:extra-globals "GAMESTATE,SCREEN_CENTER_X,ETC"}}))))
-
-  ;; (it "can accept a way to allow all globals that match a pattern"
-  ;;   (local self (doto [] (setup-server {:fennel-ls {:global-pattern "[A-Z]+"}}))))
 
   ;; (it "can turn off strict globals"
-  ;;   (local self (doto [] (setup-server {:fennel-ls {:globals "*"}}))))
+  ;;   (local self (doto [] (setup-server {:fennel-ls {:checks {:globals false}}}))))
 
   ;; (it "can treat globals as a warning instead of an error"
   ;;   (local self (doto [] (setup-server {:fennel-ls {:diagnostics {:E202 "warning"}}})))))
+
+  ;; I suspect this test will fail when I put warnings for module return type
+  (it "can disable some lints"
+    (let [client (create-client {:fennel-ls {:checks {:unused-definition false}}})
+          responses (client:open-file! (.. ROOT-URI :/test.fnl) "(local x 10)")]
+      (is-matching responses
+        [{:method :textDocument/publishDiagnostics
+          :params {:diagnostics [nil]}}]
+        "bad"))))