Completions now come with some doc info

src/fennel-ls/compiler.fnl

@@ -229,6 +229,9 @@ later by fennel-ls.language to answer requests from the client."
            : symbol-to-expression
            : call
            : destructure
+           ;; :fn    fn-hook
+           ;; :do    there's a do hook
+           ;; :chunk I don't know what this one is
            :assert-compile on-compile-error
            :parse-error on-parse-error
            :customhook-early-do compile-do
@@ -278,6 +281,7 @@ later by fennel-ls.language to answer requests from the client."
       (set file.scope scope)
       (set file.scopes scopes)
       (set file.definitions definitions)
+      (set file.definitions-by-scope definitions-by-scope)
       (set file.diagnostics diagnostics)
       (set file.references references)
       (set file.deep-references references)

src/fennel-ls/formatter.fnl

@@ -3,20 +3,13 @@ This module is for formatting code that needs to be shown to the client
 in tooltips and other notification messages. It is NOT for formatting
 user code."
 
-(local {: sym
+(local {: sym?
-        : sym?
+        : view} (require :fennel))
-        : view
-        : list} (require :fennel))
 (local {: type=} (require :fennel-ls.utils))
 
-
-(local -fn- (sym :fn))
-(local -varg- (sym :...))
-
 (λ code-block [str]
   (.. "```fnl\n" str "\n```"))
 
-(local width 80)
 (fn fn-format [special name args docstring]
   (.. (code-block (.. "("
                       (tostring special)
@@ -27,48 +20,76 @@ user code."
                       " ...)"))
       (if docstring (.. "\n" docstring) "")))
 
+(λ fn? [symbol]
+  (if (sym? symbol)
+    (let [name (tostring symbol)]
+      (or (= name "fn")
+          (= name "λ")
+          (= name "lambda")))))
 
-(λ fn? [sym]
+(λ analyze-fn [ast]
-  (if (sym? sym)
+  "if ast is a function definition, try to fill out as much of this as possible:
-    (let [sym (tostring sym)]
+{: name
-      (or (= sym "fn")
+ : arglist
-          (= sym "λ")
+ : docstring
-          (= sym "lambda")))))
+ : fntype}
+fntype is one of fn or λ or lambda"
+  (case ast
+    ;; name + docstring
+    (where [fntype name arglist docstring _body]
+      (fn? fntype)
+      (sym? name)
+      (type= arglist :table)
+      (type= docstring :string))
+    {: fntype : name : arglist : docstring}
+    ;; docstring
+    (where [fntype arglist docstring _body]
+      (fn? fntype)
+      (type= arglist :table)
+      (type= docstring :string))
+    {: fntype : arglist : docstring}
+    ;; name
+    (where [fntype name arglist]
+      (fn? fntype)
+      (sym? name)
+      (type= arglist :table))
+    {: fntype : name : arglist}
+    ;; none
+    (where [fntype arglist]
+      (fn? fntype)
+      (type= arglist :table))
+    {: fntype : arglist}))
 
 (λ hover-format [result]
   "Format code that will appear when the user hovers over a symbol"
-  (match result.definition
+  {:kind "markdown"
-    ;; name + docstring
+   :value
-    (where [special name args docstring _body]
+   (case (analyze-fn result.definition)
-      (fn? special)
+     {:fntype ?fntype :name ?name :arglist ?arglist :docstring ?docstring} (fn-format ?fntype ?name ?arglist ?docstring)
-      (sym? name)
+     _ (code-block
-      (type= args :table)
+         (if (-?>> result.keys length (< 0))
-      (type= docstring :string))
+           (.. "ERROR, I don't know how to show this "
-    (fn-format special name args docstring)
+               "(. "
-    ;; docstring
+               (view result.definition {:prefer-colon? true}) " "
-    (where [special args docstring _body]
+               (view result.keys {:prefer-colon? true}) ")")
-      (fn? special)
+           (view result.definition {:prefer-colon? true}))))})
-      (type= args :table)
-      (type= docstring :string))
-    (fn-format special nil args docstring)
-    ;; name
-    (where [special name args]
-      (fn? special)
-      (sym? name)
-      (type= args :table))
-    (fn-format special name args nil)
-    ;; none
-    (where [special args]
-      (fn? special)
-      (type= args :table))
-    (fn-format special nil args nil)
-    ?anything-else
-    (code-block
-      (if (-?>> result.keys length (< 0))
-        (.. "ERROR, I don't know how to show this "
-            "(. "
-            (view ?anything-else {:prefer-colon? true}) " "
-            (view result.keys {:prefer-colon? true}) ")")
-        (view ?anything-else {:prefer-colon? true})))))
 
-{: hover-format}
+;; 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})
+
+(λ completion-item-format [label def]
+  "make a completion item"
+  (doto
+    (case (analyze-fn def.definition)
+      {:fntype _} {: label
+                   :kind (if (label:find ":") kinds.Method kinds.Function)}
+      _ {: label
+         :kind kinds.Variable})
+    (tset :documentation (hover-format def))))
+
+{: hover-format
+ : completion-item-format}

src/fennel-ls/handlers.fnl

@@ -5,9 +5,9 @@ Every time the client sends a message, it gets handled by a function in the corr
 (ie, a textDocument/didChange notification will call notifications.textDocument/didChange
  and a textDocument/defintion request will call requests.textDocument/definition)"
 
-(local {: pos->byte : apply-changes}   (require :fennel-ls.utils))
+(local {: pos->byte : apply-changes} (require :fennel-ls.utils))
 (local message (require :fennel-ls.message))
-(local state   (require :fennel-ls.state))
+(local state (require :fennel-ls.state))
 (local language (require :fennel-ls.language))
 (local formatter (require :fennel-ls.formatter))
 (local utils (require :fennel-ls.utils))
@@ -101,7 +101,7 @@ Every time the client sends a message, it gets handled by a function in the corr
           (table.insert result
                 (message.range-and-uri definition.binding result-file)))
 
-        ;; TODO if the request says not to include duplicates, don't include duplicates
+        ;; TODO don't include duplicates
         result)
       (catch _ nil))))
 
@@ -110,8 +110,8 @@ Every time the client sends a message, it gets handled by a function in the corr
         byte (pos->byte file.text position.line position.character)]
     (case-try (language.find-symbol file.ast byte)
       symbol (language.search-main self file symbol {} byte)
-      result {:contents {:kind "markdown"
+      result {:contents (formatter.hover-format result)
-                         :value (formatter.hover-format result)}}
+              :range (message.ast->range symbol file)}
       (catch _ nil))))
 
 
@@ -126,7 +126,19 @@ Every time the client sends a message, it gets handled by a function in the corr
       (set scope scope.parent))
     result))
 
-(λ scope-completion [file byte ?symbol parents]
+;; 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})
+
+(λ make-completionitem [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)))
+
+(λ scope-completion [self file byte ?symbol parents]
   (let [scope (or (accumulate [result nil
                                i parent (ipairs parents)
                                &until result]
@@ -135,13 +147,12 @@ Every time the client sends a message, it gets handled by a function in the corr
         ?parent (. parents 1)
         result []
         in-call-position? (and ?parent (= ?symbol (. ?parent 1)))]
-    (collect-scope scope :manglings #{:label $} result)
+    (collect-scope scope :manglings #(make-completionitem self file $ scope) result)
     (when in-call-position?
-      (collect-scope scope :macros #{:label $} result)
+      (collect-scope scope :macros #{:label $ :kind kinds.Keyword} result)
-      (collect-scope scope :specials #{:label $} result))
+      (collect-scope scope :specials #{:label $ :kind kinds.Keyword} result))
     (icollect [_ k (ipairs file.allowed-globals) &into result]
-      (do ;(print (view k)) ;; TODO
+        {:label k :kind kinds.Variable})))
-        {:label k}))))
 
 (λ field-completion [self file symbol split]
   (case (. file.references symbol)
@@ -152,18 +163,22 @@ Every time the client sends a message, it gets handled by a function in the corr
         {: definition}
         (case (values definition (type definition))
           (_str :string) (icollect [k v (pairs string)]
-                           {:label k})
+                           {:label k :kind kinds.Field})
           (tbl :table) (icollect [k v (pairs tbl)]
                          (if (= (type k) :string)
-                           {:label k})))
+                           {:label k :kind kinds.Field})))
         _ nil))))
 
+(λ create-completion-item [self file name scope]
+  (let [result (language.search-name-and-scope self file name scope)]
+    {:label result.label :kind result.kind}))
+
 (λ requests.textDocument/completion [self send {: position :textDocument {: uri}}]
   (let [file (state.get-by-uri self uri)
         byte (pos->byte file.text position.line position.character)
         (?symbol parents) (language.find-symbol file.ast byte)]
     (case (-?> ?symbol utils.multi-sym-split)
-      (where (or nil [_ nil])) (scope-completion file byte ?symbol parents)
+      (where (or nil [_ nil])) (scope-completion self file byte ?symbol parents)
       [_a _b &as split] (field-completion self file ?symbol split))))
 
 (λ notifications.textDocument/didChange [self send {: contentChanges :textDocument {: uri}}]

src/fennel-ls/language.fnl

@@ -2,7 +2,7 @@
 The high level analysis system that does deep searches following
 the data provided by compiler.fnl."
 
-(local {: sym? : list? : sequence? : varg? : sym : view} (require :fennel))
+(local {: sym? : list? : sequence? : varg? : sym : view : list} (require :fennel))
 (local utils (require :fennel-ls.utils))
 (local state (require :fennel-ls.state))
 
@@ -17,6 +17,22 @@ the data provided by compiler.fnl."
 
 (var search nil) ;; all of the search functions are mutually recursive
 
+(λ stack-add-keys! [stack ?keys]
+  "add the keys to the end of the stack in reverse order"
+  (when ?keys
+    (fcollect [i (length ?keys) 1 -1 &into stack]
+      (. ?keys i)))
+  stack)
+
+(λ stack-add-split! [stack split]
+  "add the split values to the end of the stack in reverse order"
+  (fcollect [i (length split) 2 -1 &into stack]
+    (. split i))
+  stack)
+
+(λ stack-add-multisym! [stack symbol]
+  (stack-add-split! stack (utils.multi-sym-split symbol)))
+
 (λ search-assignment [self file assignment stack opts]
   (let [{:binding _
          :definition ?definition
@@ -25,24 +41,16 @@ the data provided by compiler.fnl."
     (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)
-
+        (search self file ?definition (stack-add-keys! stack ?keys) opts))))
-        (do
-          (if ?keys
-            (fcollect [i (length ?keys) 1 -1 &into stack]
-              (. ?keys i)))
-          (search self file ?definition stack opts)))))
 
 (λ search-symbol [self file symbol stack opts]
   (if (= symbol -nil-)
     (values {:definition symbol} file) ;; BASE CASE !!
     (case (. file.references symbol)
-      to (search-assignment self file to
+      to (search-assignment self file to (stack-add-multisym! stack symbol) opts))))
-           (let [split (utils.multi-sym-split symbol)]
-             (fcollect [i (length split) 2 -1 &into stack]
-               (. split i))) ;; TODO test coverage for this line
-           opts))))
 
 (λ search-table [self file tbl stack opts]
   (if (. tbl (. stack (length stack)))
@@ -60,10 +68,7 @@ the data provided by compiler.fnl."
           (search self newfile newitem stack opts))))
     ;; A . form  indexes into item 1 with the other items
     [-dot- & split]
-    (search self file (. split 1)
+    (search self file (. split 1) (stack-add-split! stack split) opts)
-      (fcollect [i (length split) 2 -1 &into stack]
-        (. split i))
-      opts)
 
     ;; A do block returns the last form
     [-do- & body]
@@ -86,24 +91,59 @@ the data provided by compiler.fnl."
         (error (.. "I don't know what to do with " (view item))))))
 
 (λ search-main [self file symbol opts ?byte]
-  ;; TODO partial byting, go to different defitition sites depending on which section of the symbol the trigger happens on
+  "Find the definition of a symbol
+
+It searches backward for the definition, and then the definition of that definition, recursively.
+Over time, I will be adding more and more things that it can search through.
+
+If a ?byte is provided, it will be used to determine what part of a multisym to search.
+
+opts:
+{:stop-early? boolean}
+
+Imagine you have the following code:
+```fnl
+(local a 1)
+(local b a)
+b
+```
+If stop-early?, search-main will find the definition of `b` in (local b a).
+Otherwise, it would continue and find the value 1.
+
+Returns:
+(values
+  {:binding <where the symbol is bound. this would be the name of the function or variable>
+   :definition <the best known definition>
+   :keys <which part of the definition to look into. this can only possibly be present if stop-early?>
+   :fields <other known fields which aren't part of the definition>}
+  file)
+"
 
   ;; The stack is the multi-sym parts still to search
-  ;; for example, if I'm searching for "foo.bar.baz", my "item" or "symbol" is foo,
+  ;; for example, if I'm searching for "foo.bar.baz", my immediate priority is to find foo,
-  ;; and the stack has ["baz" "bar"], with "bar" at the "top"/"end" of the stack as the next key to search.
+  ;; and the stack has ["baz" "bar"]. "bar" is at the "top"/"end" of the stack as the next key to search.
-  (local stack
+  (if (sym? symbol)
-    (let [split (utils.multi-sym-split symbol (if ?byte (+ 1 (- ?byte symbol.bytestart))))]
+    (let [split (utils.multi-sym-split symbol (if ?byte (+ 1 (- ?byte symbol.bytestart))))
-      (fcollect [i (length split) 2 -1]
+          stack (stack-add-split! [] split)]
-        (. split i))))
+      (local {:metadata METADATA
-  (case (values (. file.references symbol) (. file.definitions symbol))
+              :scopes {:global {:specials SPECIALS}}}
-    (ref _)
+        (require :fennel.compiler))
-    (search-assignment self file ref stack opts)
+      (case (. METADATA (. SPECIALS (tostring symbol)))
-    (_ def)
+        metadata {: metadata}
-    (do
+        _ (case (. file.references symbol)
-      (if def.keys
+            ref (search-assignment self file ref stack opts)
-        (fcollect [i (length def.keys) 1 -1 &into stack]
+            _ (case (. file.definitions symbol)
-          (. def.keys i)))
+                def (search self file def.definition (stack-add-keys! stack def.keys) opts)))))))
-      (search self file def.definition stack opts))))
+
+(λ find-local-definition [file name ?scope]
+  (when ?scope
+    (or (. file.definitions-by-scope ?scope name)
+        (find-local-definition file name ?scope.parent))))
+
+(λ search-name-and-scope [self file name scope ?opts]
+  (let [stack (stack-add-multisym! [] name)]
+    (case (find-local-definition file name scope)
+      def (search self file def.definition (stack-add-keys! stack def.keys) (or ?opts {})))))
 
 (λ past? [?ast byte]
   ;; check if a byte is past an ast object
@@ -166,4 +206,5 @@ the data provided by compiler.fnl."
 {: find-symbol
  : search-main
  : search-assignment
+ : search-name-and-scope
  : search}

src/fennel-ls/message.fnl

@@ -18,7 +18,7 @@ to look to fix this in the future."
    ;; LSP errors
    :ServerNotInitialized -32002
    :UnknownErrorCode     -32001
-   :RequestFailed        -32802 ;; when the server has no excuse for failure
+   :RequestFailed        -32803 ;; when the server has no excuse for failure
    :ServerCancelled      -32802
    :ContentModified      -32801 ;; I don't think this one is useful unless we do async things
    :RequestCancelled     -32800}) ;; I don't think I'm going to even support cancelling things, that sounds like a pain

test/completion-test.fnl

@@ -23,7 +23,9 @@
 
 (describe "completions"
   (it "suggests globals"
-    (check-completion "(" 0 1 [:_G :debug :table :io :getmetatable :setmetatable :_VERSION :ipairs :pairs :next]))
+    (check-completion "(" 0 1 [:_G :debug :table :io :getmetatable :setmetatable :_VERSION :ipairs :pairs :next])
+    (check-completion "#nil\n(" 1 1 [:_G :debug :table :io :getmetatable :setmetatable :_VERSION :ipairs :pairs :next]))
+
 
   (it "suggests locals in scope"
     (check-completion "(local x 10)\n(print )" 1 7 [:x]))
@@ -105,8 +107,25 @@
 
   ;; (it "suggests fields of strings"))
   (it "suggests known fn fields of tables when using a method call multisym"
-    (check-completion "(local x {:field (fn [])})\n(x:fi" 1 5 [:field] [:table])))
+    (check-completion "(local x {:field (fn [])})\n(x:fi" 1 5 [:field] [:table]))
 
+  (describe "metadata"
+    (it "offers rich information about function completions"
+      (let [client (doto (create-client)
+                     (: :open-file! filename "(fn xyzzy [x y z] \"docstring\" nil)\n(xyzz"))
+            [{:result [completion]}] (client:completion filename 1 5)]
+        (print (view completion))
+        (assert completion.label "completion label")
+        (assert completion.kind "completion kind")
+        ;; (assert (?. completion :labelDetails :description) "fully qualified names or file path")
+        (assert completion.documentation "completion 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 "suggests known fn keys when using the `:` special")
   ;; (it "suggests known keys when using the `.` special")

test/misc-test.fnl

@@ -56,5 +56,7 @@
     (let [self (create-client)
           state (require :fennel-ls.state)
           searcher (require :fennel-ls.searcher)]
-     (is.not.nil (searcher.lookup self.server :crash-files.test))
+     (is.not.nil (searcher.lookup self.server :crash-files.test1))
-     (is.not.nil (state.get-by-module self.server :crash-files.test)))))
+     (is.not.nil (state.get-by-module self.server :crash-files.test1)))))
+     ; (is.not.nil (searcher.lookup self.server :crash-files.test2))
+     ; (is.not.nil (state.get-by-module self.server :crash-files.test2)))))

test/test-project/crash-files/test2.fnl

@@ -0,0 +1,2 @@
+;; fennel-ls: macro-file
+(f)