macro-path and metadata for builtin macros and a couple bug fixes

src/fennel-ls/compiler.fnl

@@ -6,6 +6,7 @@ later by fennel-ls.language to answer requests from the client."
 (local {: sym? : list? : sequence? : sym : view &as fennel} (require :fennel))
 (local message (require :fennel-ls.message))
 (local utils (require :fennel-ls.utils))
+(local searcher (require :fennel-ls.searcher))
 
 ;; words surrounded by - are symbols,
 ;; because fennel doesn't allow 'require in a runtime file
@@ -40,7 +41,7 @@ later by fennel-ls.language to answer requests from the client."
 (λ is-values? [?ast]
   (and (list? ?ast) (= (sym :values) (. ?ast 1))))
 
-(λ compile [self file]
+(λ compile [{:configuration {: macro-path} : root-uri} 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))
@@ -263,6 +264,12 @@ later by fennel-ls.language to answer requests from the client."
                 : scope}
           parser (partial pcall (fennel.parser file.text file.uri opts))
           ast (icollect [ok ok-2 ast parser &until (not (and ok ok-2))] ast)]
+
+
+      ;; This is bad; we mutate fennel.macro-path
+      (let [old-macro-path fennel.macro-path]
+        (set fennel.macro-path (searcher.add-workspaces-to-path macro-path [root-uri]))
+
         ;; compile
         (each [_i form (ipairs (if macro-file? (ast->macro-ast ast) ast))]
           (case (xpcall #(fennel.compile form opts) fennel.traceback)
@@ -273,6 +280,8 @@ later by fennel-ls.language to answer requests from the client."
           ;   {:range (message.pos->range 0 0 0 0)
           ;    :message (.. "unrecoverable compiler error: " err)})
 
+        (set fennel.macro-path old-macro-path))
+
       ; (each [sym target (pairs references)]
       ;   (if
       ;     (sym? target)

src/fennel-ls/diagnostics.fnl

@@ -1,3 +1,7 @@
+"Diagnostics
+
+Goes through a file and mutates the `file.diagnostics` field, filling it with diagnostics."
+
 (local language (require :fennel-ls.language))
 (local message (require :fennel-ls.message))
 (local utils (require :fennel-ls.utils))

src/fennel-ls/handlers.fnl

@@ -137,7 +137,9 @@ Every time the client sends a message, it gets handled by a function in the corr
 (λ make-completion-item [self file name scope]
   ;; TODO consider passing stop-early?
   (case (language.search-name-and-scope self file name scope)
-    def (formatter.completion-item-format name def)))
+    def (formatter.completion-item-format name def)
+    _ {:label name}))
+
 
 (λ scope-completion [self file byte ?symbol parents]
   (let [scope (or (accumulate [result nil
@@ -150,8 +152,8 @@ Every time the client sends a message, it gets handled by a function in the corr
         in-call-position? (and ?parent (= ?symbol (. ?parent 1)))]
     (collect-scope scope :manglings #(make-completion-item self file $ scope) result)
     (when in-call-position?
-      (collect-scope scope :macros #{:label $ :kind kinds.Keyword} result)
+      (collect-scope scope :macros #(doto (make-completion-item self file $ scope) (tset :kind kinds.Keyword)) result)
-      (collect-scope scope :specials #(make-completion-item self file $ scope) result))
+      (collect-scope scope :specials #(doto (make-completion-item self file $ scope) (tset :kind kinds.Operator)) result))
     (icollect [_ k (ipairs file.allowed-globals) &into result]
       (make-completion-item self file k scope))))
 
@@ -195,9 +197,14 @@ Every time the client sends a message, it gets handled by a function in the corr
   (send (message.diagnostics file))
   (set file.open? true))
 
+(λ notifications.textDocument/didSave [self send {:textDocument {: uri}}]
+  ;; TODO be careful about which modules need to be recomputed, and also eagerly flush existing files
+  (tset (require :fennel) :macro-loaded []))
+
 (λ notifications.textDocument/didClose [self send {:textDocument {: uri}}]
   (local file (state.get-by-uri self uri))
   (set file.open? false)
+  (tset (require :fennel) :macro-loaded [])
   ;; TODO only reload from disk if we didn't get a didSave, instead of always
   (state.flush-uri self uri))
 

src/fennel-ls/language.fnl

@@ -40,7 +40,6 @@ the data provided by compiler.fnl."
          :fields ?fields} assignment]
     (if (and (= 0 (length stack)) opts.stop-early?)
         (values assignment file) ;; BASE CASE!!
-
         ;; search a virtual field from :fields
         (and (not= 0 (length stack)) (?. ?fields (. stack (length stack))))
         (search-assignment self file (. ?fields (table.remove stack)) stack opts)
@@ -67,19 +66,24 @@ the data provided by compiler.fnl."
         (let [newitem (. newfile.ast (length newfile.ast))]
           (search self newfile newitem stack (doto opts (tset :searched-through-require true))))))
     ;; A . form  indexes into item 1 with the other items
-    [-dot- & split]
+    (where [-dot- & split] (. split 1))
     (search self file (. split 1) (stack-add-split! stack split) opts)
 
     ;; A do block returns the last form
-    [-do- & body]
+    (where [-do- & body] (. body 1))
     (search self file (. body (length body)) stack opts)
 
-    [-let- _binding & body]
+    (where [-let- _binding & body] (. body 1))
     (search self file (. body (length body)) stack opts)
 
     ;; functions evaluate to "themselves"
     [-fn-]
-    (values {:definition call} file))) ;; BASE CASE !!
+    (values {:definition call} file) ;; BASE CASE !!
+
+    ;; if we don't know, give up
+    _
+    (if (= 0 (length stack))
+        (values {:definition call} file)))) ;; BASE CASE!!
 
 (set search
   (λ search [self file item stack opts]
@@ -91,7 +95,8 @@ the data provided by compiler.fnl."
         (error (.. "I don't know what to do with " (view item))))))
 
 (local {:metadata METADATA
-        :scopes {:global {:specials SPECIALS}}}
+        :scopes {:global {:specials SPECIALS
+                          :macros MACROS}}}
   (require :fennel.compiler))
 
 (λ search-main [self file symbol opts ?byte]
@@ -150,7 +155,7 @@ Returns:
   "find a definition just from the name of the item, and the scope it is in"
   (assert (= (type name) :string))
   (let [stack (stack-add-multisym! [] name)]
-    (case (. METADATA (. SPECIALS name))
+    (case (. METADATA (or (. MACROS name) (. SPECIALS name)))
       metadata {:binding (sym name) : metadata}
       _ (case (global-info self name)
          global-item global-item

src/fennel-ls/searcher.fnl

@@ -41,4 +41,5 @@ I suspect this file may be gone after a bit of refactoring."
     modname (utils.path->uri modname)
     nil nil))
 
-{: lookup}
+{: lookup
+ : add-workspaces-to-path}

src/fennel-ls/state.fnl

@@ -1,9 +1,9 @@
 "State
 This module keeps track of the state of the language server.
-There are helpers to get file objects, and in the future, there
+There are helpers to get files (get-by functions are all for
-will be functions for managing user options. There is no global
+getting files), and there's stuff for configuration options.
-state in this project: all state will be stored in the \"self\"
+There is no global state in this project: all state is stored
-object."
+in the \"self\" object."
 
 (local searcher (require :fennel-ls.searcher))
 (local utils (require :fennel-ls.utils))
@@ -65,7 +65,7 @@ object."
 ;; allow some globals
 ;; pick from existing libraries of globals (ie love2d)
 ;; pick between different versions of lua (ie luajit)
-;; pick a "compat always" mode that accpets anything if it could be valid in any lua
+;; pick a "compat always" mode that accepts anything if it could be valid in any lua
 ;; 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
 

src/fennel-ls/utils.fnl

@@ -8,11 +8,13 @@ These functions are all pure functions, which makes me happy."
     (= (str:sub 1 len) pre)))
 
 (λ uri->path [uri]
+  "Strips the \"file://\" prefix from a uri to turn it into a path. Throws an error if it is not a path uri"
   (local prefix "file://")
-  (assert (startswith uri prefix))
+  (assert (startswith uri prefix) "encountered a URI that is not a file???")
   (string.sub uri (+ (length prefix) 1)))
 
 (λ path->uri [path]
+  "Prepents the \"file://\" prefix to a path to turn it into a uri"
   (.. "file://" path))
 
 (λ next-line [str ?from]
@@ -25,7 +27,7 @@ These functions are all pure functions, which makes me happy."
 (λ pos->byte [str line col]
   "convert a 0-indexed line and column into a 1-indexed byte. Doesn't yet handle UTF8 UTF16 magic from the protocol"
   (var sofar 1)
-  (for [_ 1 line :until (not sofar)]
+  (for [_ 1 line &until (not sofar)]
     (set sofar (next-line str sofar)))
   (if sofar
     (+ sofar col)

test/completion-test.fnl

@@ -1,4 +1,4 @@
-(import-macros {: is-matching : describe : it : before-each} :test)
+(import-macros {: is-matching : is-casing : describe : it : before-each} :test)
 (local is (require :test.is))
 
 (local {: view} (require :fennel))
@@ -30,6 +30,9 @@
   (it "suggests locals in scope"
     (check-completion "(local x 10)\n(print )" 1 7 [:x]))
 
+  (it "suggests locals where the definition can't be found"
+    (check-completion "(local x (doto 10 or and +))\n(print )" 1 7 [:x]))
+
   (it "suggests locals in scope at the top level"
     (check-completion "(local x 10)\n\n" 1 0 [:x]))
 
@@ -59,6 +62,9 @@
     (it "still completes with no body in the `let`"
       (check-completion "(let [x 10 y 20]\n  )" 1 2 [:x :y]))
 
+    (it "still completes with no body in the `let` and no close parentheses"
+      (check-completion "(local foo 10)\n(local x (let [y f]\n" 1 18 [:foo]))
+
     (it "still completes items from the previous definitions in the same `let`"
       (check-completion "(let [a 10\n      b 20\n      " 1 6 [:a :b]))
 
@@ -110,6 +116,13 @@
     (check-completion "(local x {:field (fn [])})\n(x:fi" 1 5 [:field] [:table]))
 
   (describe "metadata"
+    ;; CompletionItemKind
+    (local kinds
+      {:Text 1 :Method 2 :Function 3 :Constructor 4 :Field 5 :Variable 6 :Class 7
+       :Interface 8 :Module 9 :Property 10 :Unit 11 :Value 12 :Enum 13 :Keyword 14
+       :Snippet 15 :Color 16 :File 17 :Reference 18 :Folder 19 :EnumMember 20
+       :Constant 21 :Struct 22 :Event 23 :Operator 24 :TypeParameter 25})
+
     (it "offers rich information about function completions"
       (let [client (doto (create-client)
                      (: :open-file! filename "(fn xyzzy [x y z] \"docstring\" nil)\n(xyzz"))
@@ -117,9 +130,35 @@
         ;; TODO this seems a little bit weird to assert
         (is.same :xyzzy completion.label "the first completion should be xyzzy")
         (assert completion.kind "completion kind should be present")
-        (assert completion.documentation "completion documentation should be present")))))
+        (assert completion.documentation "completion documentation should be present")))
 
-    ; (it "offers rich information about global completions"
+    (it "offers rich information about builtin/special completions"
+      (let [client (doto (create-client)
+                     (: :open-file! filename "("))
+            [{:result completions}] (client:completion filename 0 1)
+            completion (accumulate [item nil _ completion (ipairs completions) &until item] (if (= completion.label :local) completion))]
+        (is-casing
+          completion
+          (where
+            {:label :local
+             :kind (= kinds.Operator)
+             :documentation documentation}
+            (not= documentation :nil)))))
+
+    (it "offers rich information about builtin-macro completions"
+      (let [client (doto (create-client)
+                     (: :open-file! filename "("))
+            [{:result completions}] (client:completion filename 0 1)
+            completion (accumulate [item nil _ completion (ipairs completions) &until item] (if (= completion.label :-?>) completion))]
+        (is-casing
+          completion
+          (where
+            {:label :-?>
+             :kind (= kinds.Keyword)
+             :documentation documentation}
+            (not= documentation :nil)))))))
+
+    ; (it "offers rich information about everything"
     ;   (let [client (doto (create-client)
     ;                  (: :open-file! filename "("))
     ;         [{:result completions}] (client:completion filename 0 1)
@@ -135,15 +174,15 @@
     ;     (each [_ completion (ipairs completions)]
     ;       (is.same (type completion.label) :string "unlabeled completion")
     ;       (is.same (type completion.kind) :number (.. completion.label " needs a kind"))
-    ;       (is.same (type completion.documentation) :table (.. completion.label " needs documentation")))))))
+    ;       (is.same (type completion.documentation) :table (.. completion.label " needs documentation"))
+    ;       (is.not.same completion.documentation :nil (.. completion.label " needs documentation")))))))
 
 
-    ;; (it "offers rich information about macro completions")
     ;; (it "offers rich information about variable completions")
     ;; (it "offers rich information about field completions")
     ;; (it "offers rich information about method completions")
     ;; (it "offers rich information about module completions")
-    ;; (it "offers rich information about macromodule completions")))
+    ;; (it "offers rich information about macro-module completions")))
 
   ;; (it "suggests known fn keys when using the `:` special")
   ;; (it "suggests known keys when using the `.` special")

test/init-macros.fnl

@@ -36,7 +36,22 @@
           ,(view pattern)
           ,(and ?msg `(.. "\n" ,?msg))))))
 
+(fn is-casing [item pattern ?msg]
+  "check if item matches a pattern according to fennel's `match` builtin"
+  `(case ,item
+    ,pattern nil
+    ?otherwise#
+    (error
+      (.. "Pattern did not match:\n"
+          (let [fennel# (require :fennel)]
+            (fennel#.view ?otherwise#))
+          "\ndid not match pattern:\n"
+          ,(view pattern)
+          ,(and ?msg `(.. "\n" ,?msg))))))
+
+
 {: it
  : describe
  : is-matching
+ : is-casing
  : before-each}

test/is.fnl

@@ -5,6 +5,7 @@
 (setmetatable {:equal #(do ((. (expect $1) :to :be) $2) true)
                :same  #(do ((. (expect $1) :to :equal) $2 $3) true)
                :nil #(do ((. (expect $1) :to_not :exist)) true)
-               :not {:nil #(do ((. (expect $1) :to :exist)) true)}
+               :not {:nil #(do ((. (expect $1) :to :exist)) true)
+                     :same #(do ((. (expect $1) :to_not :equal) $2))}
                :truthy #(do ((. (expect $1) :to :be :truthy)) true)}
               {:__call #(do ((. (expect $2) :to :be :truthy)) true)})

test/settings-test.fnl

@@ -14,12 +14,12 @@
         [{:result {:range _range}}]
         "error message")))
 
-  ;; (it "can set the path"
+  (it "can set the macro path"
-  ;;   (let [client (doto (create-client {:fennel-ls {:macro-path "./?/?.fnl"}})
+    (let [client (create-client {:fennel-ls {:macro-path "./?/?.fnl"}})
-  ;;                  (: :open-file! (.. ROOT-URI :/test.fnl) "(import-macros {: this-is-in-modname} :modname)"))]
+          responses (client:open-file! (.. ROOT-URI :/test.fnl) "(import-macros {: this-is-in-modname} :modname)")]
-  ;;     (is-matching
+      (print ((. (require :fennel) :view) responses))))
-  ;;         (client:definition (.. ROOT-URI :/test.fnl) 0 12)
+
-  ;;         [{:result {:range message}}]))))
+  ;; (it "recompiles modules if the macro files are modified)"
 
   ;; (it "can infer the macro path from fennel-path"
   ;;   (local self (doto [] (setup-server {:fennel-ls {:fennel-path "./?/?.fnl"}}))))