Merge pull request #19 from CFiggers/dev

v0.0.4

libs/fmt.janet

@@ -107,7 +107,7 @@
   "A list of forms that are control forms and should be indented two spaces."
   (invert ["fn" "match" "with" "with-dyns" "def" "def-" "var" "var-" "defn" "defn-"
            "varfn" "defmacro" "defmacro-" "defer" "edefer" "loop" "seq" "tabseq" "generate" "coro"
-           "for" "each" "eachp" "eachk" "case" "cond" "defglobal" "varglobal"
+           "for" "each" "eachp" "eachk" "case" "cond" "do" "defglobal" "varglobal"
            "if" "when" "when-let" "when-with" "while" "with-syms" "with-vars"
            "if-let" "if-not" "if-with" "let" "short-fn" "try" "unless" "default" "forever" "upscope"
            "repeat" "eachy" "forv" "compwhen" "compif" "ev/spawn" "ev/do-thread" "ev/with-deadline"
@@ -232,4 +232,4 @@
   [file]
   (def source (slurp file))
   (def out (format source))
-  (spit file out))
+  (spit file out))

project.janet

@@ -1,21 +1,26 @@
 (declare-project
   :name "janet-lsp"
   :description "A Language Server (LSP) for the Janet Programming Language"
-  :version "0.0.3"
+  :version "0.0.4"
   :dependencies ["https://github.com/janet-lang/spork.git"
                  "https://github.com/ianthehenry/judge.git"])
 
-(def cflags
-  (case (os/which)
-    :windows []
-    ["-s"]))
+# (def cflags
+#   (case (os/which)
+#     :windows []
+#     ["-s"]))
 
-(declare-executable
-  :name "janet-lsp"
-  :entry "src/main.janet"
-  :cflags cflags
-  :install true)
+# (declare-executable
+#   :name "janet-lsp"
+#   :entry "src/main.janet"
+#   :cflags cflags
+#   :install true)
 
 (declare-archive
- :name "janet-lsp"
- :entry "/src/main")
+  :name "janet-lsp"
+  :entry "/src/main")
+
+(declare-binscript
+  :main "src/janet-lsp"
+  :hardcode-syspath true
+  :is-janet true)

src/eval.janet

@@ -61,6 +61,8 @@
     (when ret
       (buffer/push-string buf str)
       (buffer/push-string buf "\n")))
+
+  (setdyn :eval-env (make-env root-env))
 
   (def eval-fiber
     (fiber/new

src/janet-lsp

@@ -0,0 +1,4 @@
+(import janet-lsp)
+
+(defn main [& args]
+  (janet-lsp/main ;args))

src/lookup.janet

@@ -44,8 +44,6 @@
 (test (peg/match word-peg "") nil)
 
 (defn word-at [location source]
-  # (logging/log (string/format "word-at received location: %m" location))
-  # (logging/log (string/format "word-at received source: %m" source))
   (let [{:character character-pos :line line-pos} location
         line ((string/split "\n" source) line-pos)
         parsed (or (sort-by last (or (peg/match word-peg line) @[[0 "" 0]])))
@@ -126,35 +124,40 @@
   (let [a 1 b 2]
     (first-where |(< (first $) 0) [[-2 :a] [-1 :b] [0 :c]])))                 
 ``)
-  (map |(string/slice sample ($ 0) ($ 1))
-       @[@[0 14]
-         @[16 263]
-         @[50 262]
-         @[78 261]
-         @[114 126]
-         @[134 249]
-         @[143 156]
-         @[169 248]
-         @[175 192]
-         @[183 191]
-         @[207 225]
-         @[216 224]
-         @[240 247]
-         @[282 390]
-         @[304 311]
-         @[314 389]
-         @[333 388]
-         @[347 362]
-         @[350 359]]))
+  (test (map |[$ (string/slice sample ($ 0) ($ 1))] @[@[0 14] @[16 263] @[50 262] @[78 261] @[114 126] @[134 249] @[143 156] @[169 248] @[175 192] @[183 191] @[207 225] @[216 224] @[240 247] @[282 390] @[304 311] @[314 389] @[333 388] @[347 362] @[350 359]])
+    @[[@[0 14] "(import spork)"]
+      [@[16 263] "(defmacro first-where [pred ds]\n  (with-syms [$pred $ds]\n    ~(let [,$pred ,pred ,$ds ,ds]\n       (var ret \"\")\n       (for i 0 (length ,$ds)\n            (when (,$pred (,$ds i))\n              (set ret (,$ds i))\n              (break)))\n       ret)))"]
+      [@[50 262] "(with-syms [$pred $ds]\n    ~(let [,$pred ,pred ,$ds ,ds]\n       (var ret \"\")\n       (for i 0 (length ,$ds)\n            (when (,$pred (,$ds i))\n              (set ret (,$ds i))\n              (break)))\n       ret))"]
+      [@[78 261] "(let [,$pred ,pred ,$ds ,ds]\n       (var ret \"\")\n       (for i 0 (length ,$ds)\n            (when (,$pred (,$ds i))\n              (set ret (,$ds i))\n              (break)))\n       ret)"]
+      [@[114 126] "(var ret \"\")"]
+      [@[134 249] "(for i 0 (length ,$ds)\n            (when (,$pred (,$ds i))\n              (set ret (,$ds i))\n              (break)))"]
+      [@[143 156] "(length ,$ds)"]
+      [@[169 248] "(when (,$pred (,$ds i))\n              (set ret (,$ds i))\n              (break))"]
+      [@[175 192] "(,$pred (,$ds i))"]
+      [@[183 191] "(,$ds i)"]
+      [@[207 225] "(set ret (,$ds i))"]
+      [@[216 224] "(,$ds i)"]
+      [@[240 247] "(break)"]
+      [@[282 390] "(defn main [& args]\n  (+ 1 1)\n  (let [a 1 b 2]\n    (first-where |(< (first $) 0) [[-2 :a] [-1 :b] [0 :c]])))"]
+      [@[304 311] "(+ 1 1)"]
+      [@[314 389] "(let [a 1 b 2]\n    (first-where |(< (first $) 0) [[-2 :a] [-1 :b] [0 :c]]))"]
+      [@[333 388] "(first-where |(< (first $) 0) [[-2 :a] [-1 :b] [0 :c]])"]
+      [@[347 362] "(< (first $) 0)"]
+      [@[350 359] "(first $)"]]))
 
 (defn sexp-at [location source]
   (let [{:character character-pos :line line-pos} location
         idx (+ character-pos (sum (map (comp inc length) (array/slice (string/split "\n" source) 0 line-pos))))
-        s-exps (peg/match sexp-peg source)
-        sexp-range (last (filter |(<= ($ 0) idx ($ 1)) s-exps))]
-    {:source (string/slice source ;sexp-range) :range sexp-range}))
+        s-exps (or (peg/match sexp-peg source) @[])] 
+    (if-let [sexp-range (last (filter |(< ($ 0) idx ($ 1)) s-exps))]
+      {:source (string/slice source ;sexp-range) :range sexp-range}
+      {:source "" :range @[line-pos character-pos]})))
 
-(test (sexp-at {:character 15 :line 2} "(def a-startup-symbol [])\n\n(import spork/argparse)") {:range @[27 50] :source "(import spork/argparse)"})
+(test (sexp-at {:line 2 :character 3} "(def a-startup-symbol [])\n\nsymbol\n\n(import spork/argparse)")
+  {:range @[2 3] :source ""})
+
+(test (sexp-at {:character 15 :line 2} "(def a-startup-symbol [])\n\n(import spork/argparse)") 
+      {:range @[27 50] :source "(import spork/argparse)"})
 
 (deftest "sexp-at"
   (def sample

src/main.janet

@@ -23,6 +23,21 @@
 (defn parse-content-length [input]
   (scan-number (string/trim ((string/split ":" input) 1))))
 
+(defn run-diagnostics [uri content]
+  (let [items @[]
+        eval-result (eval/eval-buffer content (path/basename uri))]
+
+    (each res eval-result
+      (match res
+        {:location [line col] :message message}
+        (array/push items
+                    {:range
+                     {:start {:line (max 0 (dec line)) :character col}
+                      :end {:line (max 0 (dec line)) :character col}}
+                     :message message})))
+
+    items))
+
 (defn on-document-change
   ``
   Handler for the ["textDocument/didChange"](https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#textDocument_didChange) event.
@@ -32,31 +47,24 @@
   [state params]
   (let [content (get-in params ["contentChanges" 0 "text"])
         uri (get-in params ["textDocument" "uri"])]
-
     (put-in state [:documents uri] @{:content content})
-
-    (pp (eval/eval-buffer content (path/basename uri)))
-
-    [:noresponse state]))
-
+
+    (if (dyn :push-diagnostics)
+      (let [d (run-diagnostics uri content)]
+        (if (empty? d) 
+          [:noresponse state]
+          [:ok state {:method "textDocument/publishDiagnostics"
+                      :params {:uri uri
+                               :diagnostics d}} :notify true])) 
+      [:noresponse state])))
 
 (defn on-document-diagnostic [state params]
   (let [uri (get-in params ["textDocument" "uri"])
         content (get-in state [:documents uri :content])
-        items @[]
-        eval-result (eval/eval-buffer content (path/basename uri))]
-
-    (each res eval-result
-      (match res
-        {:location [line col] :message message}
-        (array/push items
-                    {:range
-                     {:start {:line (max 0 (dec line)) :character col}
-                      :end   {:line (max 0 (dec line)) :character col}}
-                     :message message})))
+        diagnostics (run-diagnostics uri content)] 
 
     [:ok state {:kind "full"
-                :items items}]))
+                :items diagnostics}]))
 
 (defn on-document-formatting [state params]
   (let [uri (get-in params ["textDocument" "uri"])
@@ -69,7 +77,7 @@
       [:ok state :json/null]
       (do (put-in state [:documents uri] {:content new-content})
           [:ok state [{:range {:start {:line 0 :character 0}
-                               :end   {:line 1000000 :character 1000000}}
+                               :end {:line 1000000 :character 1000000}}
                        :newText new-content}]]))))
 
 (defn on-document-open [state params]
@@ -141,6 +149,12 @@
   that this server provides so the client knows what it can request.
   ``
   [state params]
+  (logging/log (string/format "on-initialize called with these params: %m" params))
+
+  (if-let [diagnostic? (get-in params ["capabilities" "textDocument" "diagnostic"])]
+    (setdyn :push-diagnostics false)
+    (setdyn :push-diagnostics true))
+
   [:ok state {:capabilities {:completionProvider {:resolveProvider true}
                              :textDocumentSync {:openClose true
                                                 :change 1 # send the Full document https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#textDocumentSyncKind
@@ -182,7 +196,7 @@
   (let [id (get message "id")
         method (get message "method")
         params (get message "params")]
-    (comment logging/log (string/format "handle-message received method request: %m" method))
+    (logging/log (string/format "handle-message received method request: %m" method))
     (case method
       "initialize" (on-initialize state params)
       "initialized" [:noresponse state]
@@ -225,19 +239,18 @@
   (let [input (file/read stdin :line)
         content-length (+ (parse-content-length input) (read-offset))
         input (file/read stdin content-length)]
-    # (print "spork/json and jayson are identical: " (deep= (json/decode input) (jayson/decode input)))
     (json/decode input)))
 
 (defn message-loop [&named state]
   (let [message (read-message)]
     (match (handle-message message state)
-      [:ok new-state response] (do
+      [:ok new-state & response] (do
                                  (logging/log "successful rpc")
-                                 (write-response stdout (rpc/success-response (get message "id") response))
+                                 (write-response stdout (rpc/success-response (get message "id") ;response))
                                  (message-loop :state new-state))
       [:noresponse new-state] (message-loop :state new-state)
 
-      [:error new-state error] (pp "unhandled error response")
+      [:error new-state err] (printf "unhandled error response: %m" err)
       [:exit] (do (file/flush stdout) (ev/sleep 2) nil))))
 
 (defn find-all-module-files [path &opt search-jpm-tree explicit results]
@@ -271,16 +284,13 @@
        (map |(string "./" $))))
 
 (defn start-language-server []
-  # (setdyn :debug true)
   (print "Starting LSP")
   (logging/log "Starting LSP")
   (when (dyn :debug) (spit "janetlsp.log.txt" ""))
 
+  (merge-module root-env jpm-defs nil true)
   (setdyn :eval-env (make-env root-env))
 
-  # (merge-module (dyn :eval-env) (((curenv) 'module/paths) :value))
-  (merge-module (dyn :eval-env) jpm-defs)
-
   (each path (find-unique-paths (find-all-module-files (os/cwd) (not ((dyn :opts) :dont-search-jpm-tree))))
     (cond
       (string/has-suffix? ".janet" path) (array/push (((dyn :eval-env) 'module/paths) :value) [path :source])
@@ -324,7 +334,7 @@
        --stdio (flag) "Use STDIO."
        [--debug -d] (flag) "Print debug messages."
        [--console -c] (flag) "Start a debug console instead of starting the Language Server."
-       [--debug-port -p] (optional :int++) "What port to start the debug console on. Defaults to 8037."]
+       [--debug-port -p] (optional :int++) "What port to start or connect to the debug console on. Defaults to 8037."]
 
       (default stdio true)
       (default debug-port 8037)
@@ -336,7 +346,7 @@
          :debug-port debug-port})
 
       (setdyn :opts opts)
-      (setdyn :debug debug)
+      (when debug (setdyn :debug true))
       (setdyn :out stderr)
 
       (if console

src/rpc.janet

@@ -1,7 +1,12 @@
 # (import spork/json)
 (import ../libs/jayson)
 
-(defn success-response [id result]
-  (jayson/encode {:jsonrpc "2.0"
-                  :id id
-                  :result result}))
+(defn success-response [id result &keys opts]
+  (def rpc 
+    (if (opts :notify)
+      (merge {:jsonrpc "2.0"}
+             result)
+      {:jsonrpc "2.0"
+       :id id
+       :result result}))
+  (jayson/encode rpc))

test/test-main.janet

@@ -78,14 +78,14 @@
 
 (deftest "test find-unique-paths"
   (test (find-unique-paths (find-all-module-files (os/cwd)))
-        @["./src/:all:.janet"
-          "./libs/:all:.janet"
-          "./test/:all:.janet"
-          "./build/:all:.jimage"]))
+    @["./src/:all:.janet"
+      "./libs/:all:.janet"
+      "./test/:all:.janet"
+      "./build/:all:.jimage"]))
 
 (deftest "test find-unique-paths"
   (test (find-unique-paths (find-all-module-files (os/cwd) true))
-        @["./src/:all:.janet"
-          "./libs/:all:.janet"
-          "./test/:all:.janet"
-          "./build/:all:.jimage"]))
+    @["./src/:all:.janet"
+      "./libs/:all:.janet"
+      "./test/:all:.janet"
+      "./build/:all:.jimage"]))