new lint invalid-flsproject-settings, and completely rewrite the way settings get checked

changelog.md

@@ -7,6 +7,7 @@
 * New lint `duplicate-table-keys` for detecting duplicate keys (eg. `{:a 1 :a 2}`)
 * New lint `mismatched-argument-count` for ensuring function calls have the right argument count
     * Disabled by default because it gives false positives when your arglist doesn't follow fennel's naming conventions
+* New lint `invalid-flsproject-settings` checks your `flsproject.fnl` file as you edit it
 
 ### Changes
 * Updated to dkjson 2.8

src/fennel-ls/config.fnl

@@ -12,10 +12,16 @@ to server.configuration. Every other use case should be read-only."
 (local docs (require :fennel-ls.docs))
 (local utils (require :fennel-ls.utils))
 (local lint (require :fennel-ls.lint))
+(local message (require :fennel-ls.message))
+(local {: view} (require :fennel))
 
 (local option-mt {})
-(fn option [default-value] (doto [default-value] (setmetatable option-mt)))
+(fn option [default-value ?validate]
+  "A flsproject.fnl configuration option. The user can provide any value that matches the type of default-value"
+  (setmetatable {: default-value :validate ?validate} option-mt))
 
+;; this default configuration gets merged with the user-provided ones
+;; the (option) values can be overridden by the user, instead of doing the merge logic
 (local default-configuration
   {:fennel-path (option "./?.fnl;./?/init.fnl;src/?.fnl;src/?/init.fnl")
    :macro-path (option (table.concat ["./?.fnlm" "./?/init.fnlm"
@@ -24,30 +30,54 @@ to server.configuration. Every other use case should be read-only."
                                       "src/?.fnlm" "src/?/init.fnlm"
                                       "src/?.fnl" "src/?/init-macros.fnl"
                                       "src/?/init.fnl"] ";"))
-   :lua-version (option "lua54")
+   :lua-version (option "lua54" docs.validate-lua-version)
    :lints (collect [_ lint (ipairs lint.list)]
             lint.name (option (not lint.disabled)))
-   :libraries (option {})
+   :libraries (option {} docs.validate-libraries)
    :extra-globals (option "")})
 
-(fn make-configuration-from-template [default ?user ?parent]
+(fn extend-path [?root extra]
-  (if (= option-mt (getmetatable default))
+  (if (not= (type extra) :string) ?root
-      (let [setting
+      ?root (.. ?root "." extra)
-             (case-try ?user
+      extra))
-               nil (?. ?parent :all)
-               nil (. default 1))]
-        (assert (= (type (. default 1)) (type setting)))
-        setting)
-      (= :table (type default))
-      (collect [k _ (pairs default)]
-          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")))
 
-(λ make-configuration [?c]
+(fn make-configuration-from-template [template ?user ?parent ?path invalid]
-  (make-configuration-from-template default-configuration ?c))
+  (if (= (getmetatable template) option-mt)
+      (let [setting (case-try ?user
+                      nil (?. ?parent :all)
+                      nil template.default-value)]
+        (if (not= (type setting) (type template.default-value))
+            (do (invalid (.. (or ?path "flsproject.fnl") " must be a " (type template.default-value)) ?user ?parent)
+                template.default-value)
+            template.validate
+            (case-try (template.validate setting #(invalid $ ?user ?parent))
+                      nil template.default-value)
+            setting))
+      (= :table (type template))
+      (case (type ?user)
+        (where (or :table :nil))
+        (do
+          (when (= (type ?user) :table)
+            (each [k (pairs ?user)]
+              (when (not (. template k))
+                (invalid (.. "didn't expect " (or (extend-path ?path k) "flsproject.fnl") "\n"
+                             "valid keys: " (view (doto (icollect [k (pairs template)] k)
+                                                        table.sort)))
+                         (. ?user k)
+                         ?user))))
+          (collect [k (pairs template)]
+              k (make-configuration-from-template
+                  (. template k)
+                  (?. ?user k)
+                  ?user
+                  (extend-path ?path k)
+                  invalid)))
+        _ (do (invalid (.. "expected " (or ?path "flsproject.fnl") " to be a table") ?user ?parent)
+              (make-configuration-from-template template nil ?parent ?path invalid)))
+      (error (.. "This is a bug with fennel-ls: default-configuration has a key that isn't a table or option: " ?path))))
+
+(λ make-configuration [?c invalid]
+  (make-configuration-from-template default-configuration ?c nil nil invalid))
 
 (λ choose-position-encoding [init-params]
   "fennel-ls natively uses utf-8, so the goal is to choose positionEncoding=\"utf-8\".
@@ -65,23 +95,33 @@ However, when not an option, fennel-ls will fall back to positionEncoding=\"utf-
      :utf-8
      :utf-16)))
 
-(λ try-parsing [{: text : uri}]
+(λ parse-flsconfig [{: text : uri}]
   (local fennel (require :fennel))
   (local [ok? _err result] [(pcall (fennel.parser text uri))])
   (if ok? result))
 
-(λ load-config [server]
+(λ load-config [server invalid]
   "This is where we can put anything that needs to react to config changes"
-
   (make-configuration
-    (when server.root-uri
+    (-?> server.root-uri
-      (-?> (files.read-file server (utils.path->uri (utils.path-join (utils.uri->path server.root-uri) "flsproject.fnl")))
+         utils.uri->path
-           try-parsing))))
+         (utils.path-join "flsproject.fnl")
+         utils.path->uri
+         (->> (files.read-file server))
+         parse-flsconfig)
+    invalid))
 
 (λ reload [server]
-  (set server.configuration (load-config server)))
+  (set server.configuration
+    (load-config server
+      ;; according to the spec it is valid to send showMessage during initialization
+      ;; but eglot will only flash the message briefly before replacing it with
+      ;; another message, and probably other clients will do similarly. so queue
+      ;; up the warnings to send *after* the initialization is complete. cheesy, eh?
+      #(table.insert server.queue (message.show-message $1 :WARN)))))
 
 (λ initialize [server params]
+  (set server.queue [])
   (set server.files {})
   (set server.modules {})
   (set server.macro-modules {})
@@ -95,18 +135,6 @@ However, when not an option, fennel-ls will fall back to positionEncoding=\"utf-
                                          (accumulate [found nil _ v (ipairs completion-item-defaults) &until found] (= v :data)))))
   (reload server))
 
-(λ validate [{: configuration} invalid]
-  (when (not= :string (type configuration.fennel-path))
-    (invalid "fennel-path should be string"))
-  (when (not= :string (type configuration.macro-path))
-    (invalid "macro-path should be string"))
-  (if (not= :table (type configuration.lints))
-      (invalid "lints should be table")
-      (each [lint (pairs configuration.lints)]
-        (when (not (. default-configuration.lints lint))
-          (invalid (.. "unknown lint: " lint) :WARN))))
-  (docs.validate-config configuration invalid))
-
 {: initialize
  : reload
- : validate}
+ : make-configuration}

src/fennel-ls/dispatch.fnl

@@ -60,7 +60,7 @@ Takes:
     (send (message.create-error :ParseError str))
     _
     (send (message.create-error :BadMessage nil msg.id)))
-  (while (and server.queue (next server.queue))
+  (while (next server.queue)
     (send (table.remove server.queue 1))))
 
 (λ handle* [server msg]

src/fennel-ls/docs.fnl

@@ -101,18 +101,23 @@ Handles grabbing the documentation from sources other than fennel code;
   (or (. specials builtin-name)
       (. macros* builtin-name)))
 
-(λ validate-config [configuration invalid]
+(λ validate-lua-version [lua-version invalid]
-  (when (not (. lua-versions configuration.lua-version))
+  (case (. lua-versions lua-version)
-    (invalid (.. "fennel-ls doesn't know about lua version "
+   version_ lua-version
-                 configuration.lua-version
+   _ (invalid (.. "fennel-ls doesn't know about lua version "
-                 "\nThe known versions are: "
+                  lua-version
-                 (table.concat (icollect [k (pairs lua-versions)] k) ", "))
+                  "\nThe known versions are: "
-             :WARN))
+                  (fennel.view (doto (icollect [k (pairs lua-versions)] k)
-  (each [library-name (pairs configuration.libraries)]
+                                     table.sort))))))
+
+(λ validate-libraries [libraries invalid]
+  (collect [library-name (pairs libraries)]
     (case (get-library library-name)
-      {:status :not-found : msg} (invalid msg :WARN))))
+      {:status :not-found : msg} (invalid msg)
+      _ (values library-name true))))
 
 {: get-global
  : get-builtin
  : get-all-globals
- : validate-config}
+ : validate-lua-version
+ : validate-libraries}

src/fennel-ls/handlers.fnl

@@ -17,19 +17,8 @@ Every time the client sends a message, it gets handled by a function in the corr
 (local requests [])
 (local notifications [])
 
-(fn validate-config [server]
-  (set server.queue (or server.queue []))
-  ;; according to the spec it is valid to send showMessage during initialization
-  ;; but eglot will only flash the message briefly before replacing it with
-  ;; another message, and probably other clients will do similarly. so queue
-  ;; up the warnings to send *after* the initialization is complete. cheesy, eh?
-  (config.validate server #(table.insert server.queue
-                                         (message.show-message
-                                          $ (or $2 :ERROR)))))
-
 (λ requests.initialize [server _send params]
   (config.initialize server params)
-  (validate-config server)
   (let [capabilities
         {:positionEncoding server.position-encoding
          :textDocumentSync {:openClose true :change 2}
@@ -239,8 +228,7 @@ Every time the client sends a message, it gets handled by a function in the corr
 
 (λ notifications.textDocument/didSave [server _send {:textDocument {: uri}}]
   (when (utils.endswith uri "flsproject.fnl")
-    (config.reload server)
+    (config.reload server))
-    (validate-config server))
 
   ;; TODO recompute for files when macro is changed
   (set fennel.macro-loaded []))

src/fennel-ls/lint.fnl

@@ -689,8 +689,8 @@ the `file.diagnostics` field, filling it with diagnostics."
     {:name \"Bob\"
      :age 25}
     ```"
-   :type :other
    :since :0.2.2-dev
+   :type :other
    :impl (fn [server file]
            (let [seen []]
              (each [ast (pairs file.lexical)]
@@ -711,6 +711,38 @@ the `file.diagnostics` field, filling it with diagnostics."
                      (each [k (pairs seen)]
                        (set (. seen k) nil))))))))})
 
+(add-lint :invalid-flsproject-settings
+  {:what-it-does
+   "Checks if the flsproject file's settings are valid."
+   :why-care?
+   "Invalid settings in flsproject.fnl won't configuree fennel-ls."
+   :example
+   "```fnl
+    {:fennel-macro-path \"macros/?.mfnl\"}
+    ```
+    Instead, use:
+    ```fnl
+    {:macro-path \"macros/?.mfnl\"}
+    ```"
+   :since :0.2.2-dev
+   :type :other
+   :impl (fn [server file]
+           (when (and (= file.uri (-?> server.root-uri
+                                       utils.uri->path
+                                       (utils.path-join "flsproject.fnl")
+                                       utils.path->uri))
+                      (not (. file.diagnostics 1)))
+             ;; circular dependency! don't tell anyone ^_^
+             (let [config (require :fennel-ls.config)]
+               (config.make-configuration (. file.ast 1)
+                                          #(coroutine.yield {:code :invalid-flsproject-settings
+                                                             :range (or (message.ast->range server file $2)
+                                                                        (message.ast->range server file $3)
+                                                                        message.unknown-range)
+                                                             :message $
+                                                             :severity message.severity.WARN}))))
+           nil)})
+
 (local lint-mt {:__tojson (fn [{: self} state] (dkjson.encode self state))
                 :__index #(. $1 :self $2)})
 

src/fennel-ls/message.fnl

@@ -88,9 +88,9 @@ LSP json objects."
   (let [params-count (length signature.parameters)]
     {:signatures [signature]
      :activeSignature 0 ; we only ever have one signature
-     :activeParameter (if (>= active-parameter params-count)
+     :activeParameter (if (<= params-count active-parameter)
                           (- params-count 1)
-                          (>= active-parameter 0)
+                          (<= 0 active-parameter)
                           active-parameter)}))
 
 (λ multisym->range [server file ast n]

test/settings.fnl

@@ -68,12 +68,18 @@
         [_init show] client.initialize-response]
     (faith.= "window/showMessage" show.method)
     (faith.match "doesn't know about lua version lua5.0" show.params.message))
-  (let [client (create-client {:main.fnl ""
+  (let [{: initialize-response : client} (create-client {:main.fnl ""
-                               :flsproject.fnl "{:libraries {:nasilemak true}}"})
+                                                         :flsproject.fnl "{:libraries {:nasilemak true}}"})
-        [_init show] client.initialize-response]
+        [_init show] initialize-response]
+    ;; showMessage
     (faith.= "window/showMessage" show.method)
     (faith.match "Could not find docset for library nasilemak"
-                 show.params.message)))
+                 show.params.message)
+    ;; diagnostic
+    (let [[diagnostics] (client:open-file! (.. client.server.root-uri "/" :flsproject.fnl) "{:libraries {:nasilemak true}}")]
+      (faith.= "textDocument/publishDiagnostics" diagnostics.method)
+      (faith.match "Could not find docset for library nasilemak" (. diagnostics.params.diagnostics 1 :message))))
+  nil)
 
 {: test-path
  : test-extra-globals