rewrite of find-symbol in preparation for completions

src/fennel-ls/language.fnl

@@ -3,6 +3,7 @@ The high level analysis system that does deep searches following
 the data provided by compiler.fnl."
 
 (local {: sym? : list? : sequence? : sym : view} (require :fennel))
+(local {: table?} (require :fennel.utils))
 (local utils (require :fennel-ls.utils))
 (local state (require :fennel-ls.state))
 
@@ -109,36 +110,36 @@ the data provided by compiler.fnl."
              byte
              (+ 1 (get-ast-info ?ast :byteend))))))
 
-(λ find-symbol [ast byte ?stack]
+(λ find-symbol [ast byte]
-  (local stack (or ?stack []))
+  (local parents [])
-  (if (or (not= :table (type ast))
+  (λ recurse [ast]
-          (does-not-contain? ast byte))
+    (if
-      nil
+      (sym? ast)
-      (and (sym? ast) (contains? ast byte))
+      (values ast parents)
-      (values ast [])
+      (do
-      (or (= 0 (length stack))
+        (table.insert parents ast)
-          (list? ast)
+        (if
-          (sequence? ast))
+          (or (sequence? ast) (list? ast))
-      ;; TODO binary search
+          (accumulate [(result done) nil
-      (accumulate
+                       i child (ipairs ast)
-        [(result stack*) nil
+                       &until result]
-         _ v (ipairs ast)
+            (if (contains? child byte)
-         &until (or result (past? v byte))]
+              (recurse child byte)))
-        (do
+          (table? ast)
-          (table.insert stack ast)
+          (accumulate [(result done) nil
-          (match (find-symbol v byte stack)
+                       key value (pairs ast)
-            ret (values ret stack)
+                       &until done]
-            nil (do (table.remove stack) nil))))
+            (if (contains? key byte)
-      (accumulate
+              (recurse key byte)
-        [(result stack*) nil
+              (contains? value byte)
-         k v (pairs ast)
+              (recurse value byte)))))))
-         &until result]
+
-        (do
+  (values
-          (table.insert stack ast)
+    (accumulate [result nil i top-level-form (ipairs ast) &until result]
-          (match (or (find-symbol k byte stack)
+      (if (contains? top-level-form byte)
-                     (find-symbol v byte stack))
+        (recurse top-level-form byte)))
-            ret (values ret stack)
+    parents))
-            nil (do (table.remove stack) nil))))))
+
 
 {: find-symbol
  : search-main

src/fennel-ls/utils.fnl

@@ -73,7 +73,7 @@ These functions are all pure functions, which makes me happy."
 (λ get-ast-info [?ast info]
   ;; find a given key of info from an AST object
   (or (?. (getmetatable ?ast) info)
-      (. ?ast info)))
+      (?. ?ast info)))
 
 (fn multi-sym-split [symbol ?offset]
   (local symbol (tostring symbol))

test/completion-test.fnl

@@ -3,34 +3,52 @@
 
 (local {: view} (require :fennel))
 (local {: ROOT-URI
-        : setup-server} (require :test.util))
+        : open-file
+        : completion-at
+        : setup-server} (require :test.utils))
 
 (local dispatch (require :fennel-ls.dispatch))
 (local message (require :fennel-ls.message))
 
-(local FILENAME (.. ROOT-URI "imaginary-file.fnl"))
+(local filename (.. ROOT-URI "imaginary-file.fnl"))
 
-(fn open-file [state text]
+(describe "completions"
-  (dispatch.handle* state
+  (it "suggests globals"
-    (message.create-notification "textDocument/didOpen"
+    (local state (doto [] setup-server))
-      {:textDocument
+    ;; empty file
-       {:uri FILENAME
+    (open-file state filename "(")
-        :languageId "fennel"
+    (let [response (dispatch.handle* state (completion-at filename 0 1))]
-        :version 1
+      ;; TODO fix this test. Write a helper that will search a table and ensure at least one value matches.
-        : text}})))
+      (is-matching response
+        (where
+          [{:result
+            [{:label a}
+             {:label b}
+             {:label c}]}]
+          (. _G a)
+          (. _G b)
+          (. _G c))
+        "oops"))))
 
-(describe "completions")
+  ;; (it "suggests locals in scope"
-  ;; (it "suggests globals"
   ;;   (local state (doto [] setup-server))
-  ;;   ;; empty file
+  ;;   (open-file state filename "(local x 10)\n(print )")
-  ;;   (open-file state "")
+  ;;   (let [response (dispatch.handle* state (completion-at filename 1 7))]
-  ;;   (let [response (dispatch.handle* state
+  ;;     (var seen-suggestion false)
-  ;;                    (message.create-request 2 "textDocument/completion"
+  ;;     (each [_ suggestion (ipairs (. response 1 :result))]
-  ;;                      {:position {:line 0 :character 0}
+  ;;       (if (= suggestion.label :x)
-  ;;                       :textDocument {:uri FILENAME}}))]
+  ;;         (set seen-suggestion true)))
-  ;;     (is-matching response nil "oops"))))
+  ;;     (assert seen-suggestion "x was not suggested"))))
 
-  ;; (it "suggests locals in scope")
+  ;; (it "treats things in a call position differently")
   ;; (it "does not suggest locals out of scope")
   ;; (it "suggests fields of tables")
-  ;; (it "knows what fields are meant to be inside of globals")
+  ;; (it "suggests known fn fields of tables when using a method call multisym")
+  ;; (it "suggests known fn keys when using the `:` special")
+  ;; (it "suggests known keys when using the `.` special")
+  ;; (it "suggests known module names in `require` and `include` and `import-macros` and `require-macros` and friends")
+  ;; (it "knows the fields of the standard lua library.")
+  ;; (it "suggests special forms for the call position of a list, but not other positions")
+  ;; (it "does not suggest special forms for the \"call\" position when a list isn't actually a call, ie destructuring assignment")
+  ;; (it "suggests keys when typing out destructuring, as in `(local {: typinghere} (require :mod))`")
+  ;; (it "only suggests tables for `ipairs` / begin work on type checking system")

test/diagnostic-test.fnl

@@ -3,7 +3,8 @@
 
 (local {: view} (require :fennel))
 (local {: ROOT-URI
-        : setup-server} (require :test.util))
+        : open-file
+        : setup-server} (require :test.utils))
 
 (local dispatch (require :fennel-ls.dispatch))
 (local message (require :fennel-ls.message))
@@ -19,19 +20,12 @@
   (table.insert t result)
   `(accumulate ,t ,body))
 
-(fn open-file [state text]
+(local filename (.. ROOT-URI "imaginary.fnl"))
-  (dispatch.handle* state
-    (message.create-notification "textDocument/didOpen"
-      {:textDocument
-       {:uri (.. ROOT-URI "imaginary-file.fnl")
-        :languageId "fennel"
-        :version 1
-        : text}})))
 
 (describe "diagnostic messages"
   (it "handles compile errors"
     (local state (doto [] setup-server))
-    (let [responses (open-file state "(do do)")
+    (let [responses (open-file state filename "(do do)")
           diagnostic
           (match responses
             [{:params {: diagnostics}}]
@@ -45,7 +39,7 @@
 
   (it "handles parse errors"
     (local state (doto [] setup-server))
-    (let [responses (open-file state "(do (print :hello(]")
+    (let [responses (open-file state filename "(do (print :hello(]")
           diagnostic
           (match responses
             [{:params {: diagnostics}}]
@@ -59,7 +53,7 @@
 
   (it "handles (match)"
     (local state (doto [] setup-server))
-    (let [responses (open-file state "(match)")]
+    (let [responses (open-file state filename "(match)")]
       (is-matching responses
         [{:params
           {:diagnostics

test/goto-definition-test.fnl

@@ -2,7 +2,7 @@
 (local is (require :luassert))
 
 (local {: ROOT-URI
-        : setup-server} (require :test.util))
+        : setup-server} (require :test.utils))
 
 (local dispatch (require :fennel-ls.dispatch))
 (local message  (require :fennel-ls.message))

test/hover-test.fnl

@@ -3,7 +3,7 @@
 
 (local {: view} (require :fennel))
 (local {: ROOT-URI
-        : setup-server} (require :test.util))
+        : setup-server} (require :test.utils))
 
 (local dispatch (require :fennel-ls.dispatch))
 (local message  (require :fennel-ls.message))

test/init.fnl

@@ -5,6 +5,5 @@
 (require :test.goto-definition-test)
 (require :test.hover-test)
 (require :test.json-rpc-test)
-(require :test.lsp-test)
 (require :test.misc-test)
 (require :test.string-processing-test)

test/lsp-test.fnl

@@ -1,28 +0,0 @@
-(import-macros {: is-matching : describe : it} :test)
-(local is (require :luassert))
-
-(local {: ROOT-PATH : ROOT-URI} (require :test.util))
-(local dispatch (require :fennel-ls.dispatch))
-
-(local server-initialize-message
-  {:id 1
-   :jsonrpc "2.0"
-   :method "initialize"
-   :params
-   {:capabilities {}
-    :clientInfo {:name "Neovim" :version "0.7.2"}
-    :initializationOptions {}
-    :processId 16245
-    :rootPath ROOT-PATH
-    :rootUri ROOT-URI
-    :trace "off"
-    :workspaceFolders [{:name ROOT-PATH
-                        :uri ROOT-URI}]}})
-
-(describe "language server"
-  (it "responds to initialize"
-    (is-matching
-      (dispatch.handle* [] server-initialize-message)
-      [{:jsonrpc "2.0" :id 1
-        :result {:capabilities {}
-                 :serverInfo {:name "fennel-ls" : version}}}])))

test/misc-test.fnl

@@ -1,22 +1,54 @@
 (import-macros {: is-matching : describe : it : before-each} :test)
 (local is (require :luassert))
 
-(local fennel (require :fennel))
+(local {: view &as fennel} (require :fennel))
-(local {: multi-sym-split} (require :fennel-ls.utils))
+(local {: setup-server
+        : open-file
+        : ROOT-URI}
+  (require :test.utils))
+
+(local language (require :fennel-ls.language))
+(local utils    (require :fennel-ls.utils))
+
+(local filename (.. ROOT-URI "imaginary.fnl"))
 
 (describe "multi-sym-split"
   (it "should be 1 on regular syms"
-    (is.same ["foo"] (multi-sym-split "foo" 2)))
+    (is.same ["foo"] (utils.multi-sym-split "foo" 2)))
 
   (it "should be 1 before the :"
-    (is.same ["foo"] (multi-sym-split "foo:bar" 3)))
+    (is.same ["foo"] (utils.multi-sym-split "foo:bar" 3)))
 
   (it "should be 2 at the :"
-    (is.same ["foo" "bar"] (multi-sym-split "foo:bar" 4)))
+    (is.same ["foo" "bar"] (utils.multi-sym-split "foo:bar" 4)))
 
   (it "should be 2 after the :"
-    (is.same ["is" "equal"] (multi-sym-split "is.equal" 5)))
+    (is.same ["is" "equal"] (utils.multi-sym-split "is.equal" 5)))
 
   (it "should be big"
-    (is.same ["a" "b" "c" "d" "e" "f"] (multi-sym-split "a.b.c.d.e.f"))
+    (is.same ["a" "b" "c" "d" "e" "f"] (utils.multi-sym-split "a.b.c.d.e.f"))
-    (is.same ["obj" "bar"] (multi-sym-split (fennel.sym "obj.bar")))))
+    (is.same ["obj" "bar"] (utils.multi-sym-split (fennel.sym "obj.bar")))))
+
+(describe "find-symbol"
+  (it "finds a symbol and parents"
+    (local state (doto [] setup-server))
+    (open-file state filename "(match [1 2 4] [1 2 sym-one] sym-one)")
+    (local file (. state.files filename))
+    (local (symbol parents) (language.find-symbol file.ast 23))
+    (is.equal symbol (fennel.sym :sym-one))
+    (is-matching
+      ;; awful way to check AST equality, but I don't mind
+      parents [[[:match] [1 2 4] [1 2 [:sym-one]] [:sym-one]] [1 2 [:sym-one]]]
+      "bad parents"))
+
+  (it "finds nothing, but still gives parents"
+    (local state (doto [] setup-server))
+    (open-file state filename "(match [1 2 4] [1 2 sym-one] sym-one)")
+    (local file (. state.files filename))
+    (local (symbol parents) (language.find-symbol file.ast 18))
+    (is.equal symbol nil)
+    (is-matching
+      parents [[[:match] [1 2 4] [1 2 [:sym-one]] [:sym-one]] [1 2 [:sym-one]]]
+      "bad parents")))
+
+;; TODO parents for failed forms

test/utils.fnl

@@ -1,4 +1,5 @@
 (local dispatch (require :fennel-ls.dispatch))
+(local message (require :fennel-ls.message))
 
 (local ROOT-PATH
   (-> (io.popen "pwd")
@@ -26,4 +27,20 @@
 (fn setup-server [state]
   (dispatch.handle* state initialization-message))
 
-{: ROOT-URI : setup-server}
+(fn open-file [state name text]
+  (dispatch.handle* state
+    (message.create-notification "textDocument/didOpen"
+      {:textDocument
+       {:uri name
+        :languageId "fennel"
+        :version 1
+        : text}})))
+
+(fn completion-at [file line character]
+  (message.create-request 2 "textDocument/completion"
+   {:position {: line : character} :textDocument {:uri file}}))
+
+{: ROOT-URI
+ : setup-server
+ : open-file
+ : completion-at}