Repository: clojure-lsp/clojure-lsp
Pull request #227 (2020-12-31 01:41:29)

Incoming Call hierarchy support
Add support for incoming call hierarchy: [SPEC](https://microsoft.github.io/language-server-protocol/specifications/specification-current/#callHierarchy_incomingCalls)

![image](https://user-images.githubusercontent.com/7820865/103389814-ea17ce80-4aef-11eb-8ef8-7222083f7182.png)



Patch:
diff --git a/README.md b/README.md
index 012a6bda..fe746e33 100644
--- a/README.md
+++ b/README.md
@@ -107,11 +107,14 @@ Bellow are all the currently supported LSP capabilities and their implementation
 | textDocument/prepareRename             |      |                                               |
 | textDocument/foldingRange              |      |                                               |
 | textDocument/selectionRange            |      |                                               |
-| textDocument/semanticTokens/full       | √    | Just `functions`, type' and `macros` ATM             |
+| textDocument/semanticTokens/full       | √    | Just `functions`, type' and `macros` ATM      |
 | textDocument/semanticTokens/full/delta |      |                                               |
 | textDocument/semanticTokens/range      | √    |                                               |
 | workspace/semanticTokens/refresh       |      |                                               |
 | textDocument/linkedEditingRange        |      |                                               |
+| textDocument/prepareCallHierarchy      | √    |                                               |
+| callHierarchy/incomingCalls            | √    |                                               |
+| callHierarchy/outgoingCalls            |      |                                               |
 | textDocument/moniker                   |      |                                               |
 </details>
 
@@ -432,7 +435,7 @@ I tried making a client but my hello world attempt didn't seem to work. If someo
 
 - Better completion item kinds
 - Full semantic tokens support
-- Call hierarchy support
+- Outgoing only Call hierarchy support
 
 ## Building local
 
diff --git a/src/clojure_lsp/feature/call_hierarchy.clj b/src/clojure_lsp/feature/call_hierarchy.clj
new file mode 100644
index 00000000..b64cc736
--- /dev/null
+++ b/src/clojure_lsp/feature/call_hierarchy.clj
@@ -0,0 +1,53 @@
+(ns clojure-lsp.feature.call-hierarchy
+  (:require
+   [clojure-lsp.db :as db]
+   [clojure-lsp.feature.document-symbol :as f.document-symbol]
+   [clojure-lsp.feature.references :as f.references]
+   [clojure-lsp.parser :as parser]
+   [clojure-lsp.refactor.edit :as edit]
+   [clojure-lsp.shared :as shared]
+   [rewrite-clj.zip :as z]
+   [clojure.tools.logging :as log]))
+
+(defn ^:private usage-by-uri->call-hierarchy-item
+  [{uri :uri {:keys [kind row col] value :str :as usage} :usage}
+   project-root]
+  (let [range (shared/->range usage)
+        entry-kind (or kind
+                       (f.document-symbol/is-declaration? usage))
+        ns-zloc (-> (get-in @db/db [:documents uri :text])
+                    (parser/loc-at-pos row col)
+                    edit/find-namespace-name)]
+    {:name value
+     :kind (f.document-symbol/entry-kind->symbol-kind entry-kind)
+     :tags [] ;; TODO whether usage is deprecated
+     :detail (or ns-zloc
+                 (shared/uri->project-related-path uri project-root))
+     :uri uri
+     :range range
+     :selection-range range}))
+
+(defn prepare [uri row col local-env project-root]
+  (let [file-type (shared/uri->file-type uri)
+        cursor-usage (f.references/find-under-cursor row col local-env file-type)]
+    [(usage-by-uri->call-hierarchy-item {:uri uri :usage cursor-usage} project-root)]))
+
+(defn ^:private usage-by-uri->incoming-usage-by-uri
+  [{{:keys [row col]} :usage uri :uri}]
+  (let [file-type (shared/uri->file-type uri)
+        zloc (-> (get-in @db/db [:documents uri :text])
+                 (parser/loc-at-pos row col))
+        local-env (get-in @db/db [:file-envs uri])
+        parent-zloc (edit/find-function-name zloc)]
+    (when parent-zloc
+      (let [{parent-row :row parent-col :col} (-> parent-zloc z/node meta)]
+        {:uri uri
+         :usage (f.references/find-under-cursor parent-row parent-col local-env file-type)}))))
+
+(defn incoming [uri row col project-root]
+  (->> (f.references/reference-usages uri row col)
+       (map usage-by-uri->incoming-usage-by-uri)
+       (remove nil?)
+       (mapv (fn [usage-by-uri]
+                 {:from-ranges []
+                  :from (usage-by-uri->call-hierarchy-item usage-by-uri project-root)}))))
diff --git a/src/clojure_lsp/feature/document_symbol.clj b/src/clojure_lsp/feature/document_symbol.clj
new file mode 100644
index 00000000..3b32119d
--- /dev/null
+++ b/src/clojure_lsp/feature/document_symbol.clj
@@ -0,0 +1,13 @@
+(ns clojure-lsp.feature.document-symbol)
+
+(defn is-declaration? [e]
+  (and (get-in e [:tags :declare])
+       (or (get-in e [:tags :local])
+         (get-in e [:tags :public]))))
+
+(defn entry-kind->symbol-kind [k]
+  (case k
+    :module :namespace
+    :function :function
+    :declaration :variable
+    :null))
diff --git a/src/clojure_lsp/handlers.clj b/src/clojure_lsp/handlers.clj
index 5d534935..1fc712c3 100644
--- a/src/clojure_lsp/handlers.clj
+++ b/src/clojure_lsp/handlers.clj
@@ -4,9 +4,11 @@
     [cljfmt.main :as cljfmt.main]
     [clojure-lsp.crawler :as crawler]
     [clojure-lsp.db :as db]
+    [clojure-lsp.feature.call-hierarchy :as f.call-hierarchy]
     [clojure-lsp.feature.code-actions :as f.code-actions]
     [clojure-lsp.feature.completion :as f.completion]
     [clojure-lsp.feature.definition :as f.definition]
+    [clojure-lsp.feature.document-symbol :as f.document-symbol]
     [clojure-lsp.feature.documentation :as f.documentation]
     [clojure-lsp.feature.refactor :as f.refactor]
     [clojure-lsp.feature.references :as f.references]
@@ -200,16 +202,9 @@
           (log/warn "Could not find element under cursor, next three known elements are:" (string/join ", " (map (comp pr-str :str) next-stuff)))
           (log/warn "Could not find element under cursor, there are no known elements after this position."))))))
 
-(defn entry-kind->symbol-kind [k]
-  (case k
-    :module :namespace
-    :function :function
-    :declaration :variable
-    :null))
-
 (defn file-env-entry->document-symbol [[e kind]]
   (let [{n :str :keys [row col end-row end-col sym]} e
-        symbol-kind (entry-kind->symbol-kind kind)
+        symbol-kind (f.document-symbol/entry-kind->symbol-kind kind)
         r {:start {:line (dec row) :character (dec col)}
            :end {:line (dec end-row) :character (dec end-col)}}]
     {:name n
@@ -218,16 +213,11 @@
      :selection-range r
      :namespace (namespace sym)}))
 
-(defn is-declaration? [e]
-  (and (get-in e [:tags :declare])
-       (or (get-in e [:tags :local])
-         (get-in e [:tags :public]))))
-
 (defn document-symbol [doc-id]
   (let [local-env (get-in @db/db [:file-envs doc-id])
         symbol-parent-map (->> local-env
                                (keep #(cond (:kind %) [% (:kind %)]
-                                            (is-declaration? %) [% :declaration]
+                                            (f.document-symbol/is-declaration? %) [% :declaration]
                                             :else nil))
                                (map file-env-entry->document-symbol)
                                (group-by :namespace))]
@@ -253,7 +243,7 @@
 
 (defn file-env-entry->workspace-symbol [uri [e kind]]
   (let [{:keys [row col end-row end-col sym]} e
-        symbol-kind (entry-kind->symbol-kind kind)
+        symbol-kind (f.document-symbol/entry-kind->symbol-kind kind)
         r {:start {:line (dec row) :character (dec col)}
            :end {:line (dec end-row) :character (dec end-col)}}]
     {:name (str sym)
@@ -267,7 +257,7 @@
            (mapcat (fn [[uri env]]
                      (->> env
                           (keep #(cond (:kind %) [% (:kind %)]
-                                       (is-declaration? %) [% :declaration]
+                                       (f.document-symbol/is-declaration? %) [% :declaration]
                                        :else nil))
                           (filter #(.contains (str (:sym (first %))) query))
                           (map (partial file-env-entry->workspace-symbol uri)))))
@@ -402,3 +392,17 @@
         usages (get-in db [:file-envs doc-id])
         data (f.semantic-tokens/range-tokens usages range)]
     {:data data}))
+
+(defn prepare-call-hierarchy
+  [doc-id row col]
+  (let [{:keys [project-root file-envs]} @db/db
+        local-env (get file-envs doc-id)]
+    (f.call-hierarchy/prepare doc-id row col local-env project-root)))
+
+(defn call-hierarchy-incoming
+  [item]
+  (let [uri (.getUri item)
+        row (inc (-> item .getRange .getStart .getLine))
+        col (inc (-> item .getRange .getStart .getCharacter))
+        project-root (:project-root @db/db)]
+    (f.call-hierarchy/incoming uri row col project-root)))
diff --git a/src/clojure_lsp/interop.clj b/src/clojure_lsp/interop.clj
index f2a6e60e..e1768dd4 100644
--- a/src/clojure_lsp/interop.clj
+++ b/src/clojure_lsp/interop.clj
@@ -7,6 +7,8 @@
     [medley.core :as medley])
   (:import
     (org.eclipse.lsp4j
+      CallHierarchyIncomingCall
+      CallHierarchyItem
       CodeAction
       CodeActionKind
       CodeLens
@@ -45,6 +47,7 @@
 (s/def ::end ::position)
 (s/def ::range (s/and (s/keys :req-un [::start ::end])
                       (s/conformer #(Range. (:start %1) (:end %1)))))
+(s/def ::selection-range ::range)
 
 (def completion-kind-enum
   {:text 1 :method 2 :function 3 :constructor 4 :field 5 :variable 6 :class 7 :interface 8 :module 9
@@ -242,8 +245,31 @@
 (s/def ::semantic-tokens (s/and (s/keys :req-un [::data]
                                   :opt-un [::result-id])
                                 (s/conformer #(doto (SemanticTokens. (:result-id %1)
-                                                                     (java.util.ArrayList. (:data %1))))))) ;;TODO need ArrayList?
-
+                                                                     (java.util.ArrayList. (:data %1)))))))
+
+(s/def ::call-hierarchy-item (s/and (s/keys :req-un [::name :symbol/kind ::uri ::range ::selection-range]
+                                            :opt-un [::tags ::detail ::data])
+                                    (s/conformer #(doto (CallHierarchyItem.)
+                                                    (.setName (:name %1))
+                                                    (.setKind (:kind %1))
+                                                    (.setUri (:uri %1))
+                                                    (.setRange (:range %1))
+                                                    (.setSelectionRange (:selection-range %1))
+                                                    (.setTags (:tags %1))
+                                                    (.setDetail (:detail %1))
+                                                    (.setData (:data %1))))))
+
+(s/def ::call-hierarchy-items (s/coll-of ::call-hierarchy-item))
+
+(s/def :call-hierarchy/from-ranges (s/coll-of ::range))
+(s/def :call-hierarchy/from ::call-hierarchy-item)
+
+(s/def ::call-hierarchy-incoming-call (s/and (s/keys :req-un [:call-hierarchy/from :call-hierarchy/from-ranges])
+                                             (s/conformer #(doto (CallHierarchyIncomingCall.)
+                                                             (.setFrom (:from %1))
+                                                             (.setFromRanges (:from-ranges %1))))))
+
+(s/def ::call-hierarchy-incoming-calls (s/coll-of ::call-hierarchy-incoming-call))
 
 (defn debeaner [inst]
   (when inst
diff --git a/src/clojure_lsp/main.clj b/src/clojure_lsp/main.clj
index 5e803ae7..443ba7c9 100644
--- a/src/clojure_lsp/main.clj
+++ b/src/clojure_lsp/main.clj
@@ -15,6 +15,8 @@
    (org.eclipse.lsp4j.services LanguageServer TextDocumentService WorkspaceService LanguageClient)
    (org.eclipse.lsp4j
      ApplyWorkspaceEditParams
+     CallHierarchyIncomingCallsParams
+     CallHierarchyPrepareParams
      CodeActionParams
      CodeLens
      CodeLensParams
@@ -348,7 +350,28 @@
                              :col (inc (.getCharacter start))
                              :end-row (inc (.getLine end))
                              :end-col (inc (.getCharacter end))}]
-                  (interop/conform-or-log ::interop/semantic-tokens (handlers/semantic-tokens-range doc-id range))))))))))
+                  (interop/conform-or-log ::interop/semantic-tokens (handlers/semantic-tokens-range doc-id range)))))))))
+
+  (^CompletableFuture prepareCallHierarchy [_ ^CallHierarchyPrepareParams params]
+    (go :prepareCallHierarchy
+        (CompletableFuture/supplyAsync
+          (reify Supplier
+            (get [_this]
+              (end
+                (let [doc-id (interop/document->decoded-uri (.getTextDocument params))
+                      pos (.getPosition params)
+                      row (inc (.getLine pos))
+                      col (inc (.getCharacter pos))]
+                  (interop/conform-or-log ::interop/call-hierarchy-items (handlers/prepare-call-hierarchy doc-id row col)))))))))
+
+  (^CompletableFuture callHierarchyIncomingCalls [_ ^CallHierarchyIncomingCallsParams params]
+    (go :callHierarchyIncomingCalls
+        (CompletableFuture/supplyAsync
+          (reify Supplier
+            (get [_this]
+              (end
+                (let [item (.getItem params)]
+                  (interop/conform-or-log ::interop/call-hierarchy-incoming-calls (handlers/call-hierarchy-incoming item))))))))))
 
 (deftype LSPWorkspaceService []
   WorkspaceService
@@ -425,6 +448,7 @@
                 (CompletableFuture/completedFuture
                   (InitializeResult. (doto (ServerCapabilities.)
                                        (.setHoverProvider true)
+                                       (.setCallHierarchyProvider true)
                                        (.setCodeActionProvider true)
                                        (.setCodeLensProvider (CodeLensOptions. true))
                                        (.setReferencesProvider true)
diff --git a/src/clojure_lsp/refactor/edit.clj b/src/clojure_lsp/refactor/edit.clj
index a7c3ca15..21e43839 100644
--- a/src/clojure_lsp/refactor/edit.clj
+++ b/src/clojure_lsp/refactor/edit.clj
@@ -37,6 +37,25 @@
       (contains? (set op-syms) (z/sexpr op-loc)) op-loc
       :else (recur (z/leftmost (z/up op-loc))))))
 
+(defn find-function-name [loc]
+  (let [function-loc (find-ops-up loc 'defn 'defn- 'def 'defmacro 'defmulti 'defonce 's/def 's/defn)]
+    (cond
+      (and function-loc
+           (= :map (-> function-loc z/next z/tag)))
+      (-> function-loc z/next z/right)
+
+      (and function-loc
+           (= :meta (-> function-loc z/next z/tag))
+           (= :map (-> function-loc z/next z/next z/tag)))
+      (-> function-loc z/next z/down z/rightmost)
+
+      (and function-loc
+           (= :meta (-> function-loc z/next z/tag)))
+      (-> function-loc z/next z/next z/next)
+
+      function-loc
+      (z/next function-loc))))
+
 (defn single-child?
   [zloc]
   (let [child (z/down zloc)]
@@ -121,6 +140,13 @@
       (z/find-value z/next 'ns) ; go to ns
       (z/up))) ; ns form
 
+(defn find-namespace-name [zloc]
+  (some-> zloc
+          find-namespace
+          z/down
+          z/next
+          z/sexpr
+          str))
 
 (defn back-to-mark-or-nil
   [zloc marker]
diff --git a/src/clojure_lsp/shared.clj b/src/clojure_lsp/shared.clj
index 612ef954..9fceba12 100644
--- a/src/clojure_lsp/shared.clj
+++ b/src/clojure_lsp/shared.clj
@@ -17,6 +17,9 @@
 (defn uri->path [uri]
   (Paths/get (URI. uri)))
 
+(defn uri->project-related-path [uri project-root]
+  (string/replace uri project-root ""))
+
 (defn ->range [{:keys [row end-row col end-col]}]
   {:start {:line (max 0 (dec row)) :character (max 0 (dec col))}
    :end {:line (max 0 (dec end-row)) :character (max 0 (dec end-col))}})


Test patch:
diff --git a/test/clojure_lsp/features/call_hierarchy_test.clj b/test/clojure_lsp/features/call_hierarchy_test.clj
new file mode 100644
index 00000000..fc46547b
--- /dev/null
+++ b/test/clojure_lsp/features/call_hierarchy_test.clj
@@ -0,0 +1,104 @@
+(ns clojure-lsp.features.call-hierarchy-test
+  (:require
+    [clojure-lsp.db :as db]
+    [clojure-lsp.feature.call-hierarchy :as f.call-hierarchy]
+    [clojure-lsp.parser :as parser]
+    [clojure.string :as string]
+    [clojure.test :refer [deftest is testing]]))
+
+(defn long-str [& strings] (string/join "\n" strings))
+
+(def a-code
+  (long-str "(ns some.a"
+            "  (:require [some.b :as b]))"
+            "(defn a-func []"
+            "  (b/b-func))"))
+
+(def b-code
+  (long-str "(ns some.b"
+            "  (:require [some.c :as c]))"
+            "(defn b-func []"
+            "  (c/c-func))"
+            "(defn b-func-2 []"
+            "  (c/c-func))"))
+
+(def c-code
+  (long-str "(ns some.c"
+            "  (:require [some.d :as d]))"
+            "(defn c-func []"
+            "  (d/d-func))"))
+
+(def d-code
+  (long-str "(ns some.d)"
+            "(defn d-func []"
+            "  (println 1))"))
+
+(def project-root "file:/")
+
+(deftest prepare
+  (reset! db/db {:file-envs
+                 {"file://some/a.clj" (parser/find-usages a-code :clj {})
+                  "file://some/b.clj" (parser/find-usages b-code :clj {})
+                  "file://some/c.clj" (parser/find-usages c-code :clj {})
+                  "file://some/d.clj" (parser/find-usages d-code :clj {})}
+                 :documents
+                 {"file://some/a.clj" {:text a-code}
+                  "file://some/b.clj" {:text b-code}
+                  "file://some/c.clj" {:text c-code}
+                  "file://some/d.clj" {:text d-code}}})
+  (testing "single element"
+    (let [items (f.call-hierarchy/prepare "file://some/d.clj" 2 7 (parser/find-usages d-code :clj {}) project-root)]
+      (is (= 1 (count items)))
+      (is (= {:name "d-func"
+              :kind :function
+              :tags []
+              :detail "some.d"
+              :uri "file://some/d.clj"
+              :range {:start {:line 1 :character 6} :end {:line 1 :character 12}}
+              :selection-range {:start {:line 1 :character 6} :end {:line 1 :character 12}}}
+             (first items))))))
+
+(deftest incoming
+  (reset! db/db {:documents
+                 {"file://some/a.clj" {:text a-code}
+                  "file://some/b.clj" {:text b-code}
+                  "file://some/c.clj" {:text c-code}
+                  "file://some/d.clj" {:text d-code}}
+                 :file-envs
+                 {"file://some/a.clj" (parser/find-usages a-code :clj {})
+                  "file://some/b.clj" (parser/find-usages b-code :clj {})
+                  "file://some/c.clj" (parser/find-usages c-code :clj {})
+                  "file://some/d.clj" (parser/find-usages d-code :clj {})}})
+  (testing "from first element"
+    (let [items (f.call-hierarchy/incoming "file://some/d.clj" 2 7 project-root)]
+      (is (= 1 (count items)))
+      (is (= {:from-ranges []
+              :from {:name "c-func"
+                     :kind :function
+                     :tags []
+                     :detail "some.c"
+                     :uri "file://some/c.clj"
+                     :range {:start {:line 2 :character 6} :end {:line 2 :character 12}}
+                     :selection-range {:start {:line 2 :character 6} :end {:line 2 :character 12}}}}
+             (first items)))))
+  (testing "for multiple element"
+    (let [items (f.call-hierarchy/incoming "file://some/c.clj" 3 7 project-root)]
+      (is (= 2 (count items)))
+      (is (= {:from-ranges []
+              :from {:name "b-func"
+                     :kind :function
+                     :tags []
+                     :detail "some.b"
+                     :uri "file://some/b.clj"
+                     :range {:start {:line 2 :character 6} :end {:line 2 :character 12}}
+                     :selection-range {:start {:line 2 :character 6} :end {:line 2 :character 12}}}}
+             (first items)))
+      (is (= {:from-ranges []
+              :from {:name "b-func-2"
+                     :kind :function
+                     :tags []
+                     :detail "some.b"
+                     :uri "file://some/b.clj"
+                     :range {:start {:line 4 :character 6} :end {:line 4 :character 14}}
+                     :selection-range {:start {:line 4 :character 6} :end {:line 4 :character 14}}}}
+             (second items))))))
diff --git a/test/clojure_lsp/refactor/edit_test.clj b/test/clojure_lsp/refactor/edit_test.clj
index 771d680a..78d0bdf1 100644
--- a/test/clojure_lsp/refactor/edit_test.clj
+++ b/test/clojure_lsp/refactor/edit_test.clj
@@ -44,3 +44,62 @@
       (is (= 'b (op-from-val (val-finder 'b) 'b)))
       (is (= 'b (op-from-val (comp z/up (val-finder 'b)) 'b))))))
 
+(deftest find-namespace-name
+  (testing "without ns on file"
+    (let [code "(foo ((x) [a] (b {c d})))"
+          zloc (-> code z/of-string (z/find-next-value z/next 'd))]
+      (is (= nil
+             (edit/find-namespace-name zloc)))))
+  (testing "with ns on file"
+    (let [code "(ns some.foo.bar (require [some.foo :as s]))\n
+                (foo ((x) [a] (b {c d})))"
+          zloc (-> code z/of-string (z/find-next-value z/next 'd))]
+      (is (= "some.foo.bar"
+             (edit/find-namespace-name zloc))))))
+
+(defn assert-function-name [code]
+  (let [zloc (-> code z/of-string (z/find-next-value z/next 'd))]
+    (is (= "foo"
+           (z/string (edit/find-function-name zloc))))))
+
+(deftest find-function-name
+  (testing "defn"
+    (testing "simple" (assert-function-name "(defn foo [] (let [a 1] d))"))
+    (testing "with map" (assert-function-name "(defn {:asd :ds} foo [] (let [a 1] d))"))
+    (testing "with meta map" (assert-function-name "(defn ^{:asd :ds} foo [] (let [a 1] d))"))
+    (testing "with meta" (assert-function-name "(defn ^:private foo [] (let [a 1] d))")))
+  (testing "defn-"
+    (testing "simple" (assert-function-name "(defn- foo [] (let [a 1] d))"))
+    (testing "with map" (assert-function-name "(defn- {:asd :ds} foo [] (let [a 1] d))"))
+    (testing "with meta map" (assert-function-name "(defn- ^{:asd :ds} foo [] (let [a 1] d))"))
+    (testing "with meta" (assert-function-name "(defn- ^:private foo [] (let [a 1] d))")))
+  (testing "def"
+    (testing "simple" (assert-function-name "(def foo (let [a 1] d))"))
+    (testing "with map" (assert-function-name "(def {:asd :ds} foo (let [a 1] d))"))
+    (testing "with meta map" (assert-function-name "(def ^{:asd :ds} foo (let [a 1] d))"))
+    (testing "with meta" (assert-function-name "(def ^:private foo (let [a 1] d))")))
+  (testing "defmacro"
+    (testing "simple" (assert-function-name "(defmacro foo [] (let [a 1] d))"))
+    (testing "with map" (assert-function-name "(defmacro {:asd :ds} foo [] (let [a 1] d))"))
+    (testing "with meta map" (assert-function-name "(defmacro ^{:asd :ds} foo [] (let [a 1] d))"))
+    (testing "with meta" (assert-function-name "(defmacro ^:private foo [] (let [a 1] d))")))
+  (testing "defmulti"
+    (testing "simple" (assert-function-name "(defmulti foo [] (let [a 1] d))"))
+    (testing "with map" (assert-function-name "(defmulti {:asd :ds} foo [] (let [a 1] d))"))
+    (testing "with meta map" (assert-function-name "(defmulti ^{:asd :ds} foo [] (let [a 1] d))"))
+    (testing "with meta" (assert-function-name "(defmulti ^:private foo [] (let [a 1] d))")))
+  (testing "defonce"
+    (testing "simple" (assert-function-name "(defonce foo (let [a 1] d))"))
+    (testing "with map" (assert-function-name "(defonce {:asd :ds} foo (let [a 1] d))"))
+    (testing "with meta map" (assert-function-name "(defonce ^{:asd :ds} foo (let [a 1] d))"))
+    (testing "with meta" (assert-function-name "(defonce ^:private foo (let [a 1] d))")))
+  (testing "s/def"
+    (testing "simple" (assert-function-name "(s/def foo :- s/String (let [a 1] d))"))
+    (testing "with map" (assert-function-name "(s/def {:asd :ds} foo :- s/String (let [a 1] d))"))
+    (testing "with meta map" (assert-function-name "(s/def ^{:asd :ds} foo :- s/String (let [a 1] d))"))
+    (testing "with meta" (assert-function-name "(s/def ^:private foo :- s/String (let [a 1] d))")))
+  (testing "s/defn"
+    (testing "simple" (assert-function-name "(s/defn foo :- s/String [] (let [a 1] d))"))
+    (testing "with map" (assert-function-name "(s/defn {:asd :ds} foo :- s/String [] (let [a 1] d))"))
+    (testing "with meta map" (assert-function-name "(s/defn ^{:asd :ds} foo :- s/String [] (let [a 1] d))"))
+    (testing "with meta" (assert-function-name "(s/defn ^:private foo :- s/String [] (let [a 1] d))"))))
diff --git a/test/clojure_lsp/shared_test.clj b/test/clojure_lsp/shared_test.clj
index b6b2e08b..1d283f41 100644
--- a/test/clojure_lsp/shared_test.clj
+++ b/test/clojure_lsp/shared_test.clj
@@ -2,6 +2,10 @@
   (:require [clojure-lsp.shared :as shared]
             [clojure.test :refer [deftest testing is]]))
 
+(deftest uri->project-related-path
+  (is (= "/src/my-project/some/ns.clj"
+        (shared/uri->project-related-path "file://home/foo/bar/my-project/src/my-project/some/ns.clj" "file://home/foo/bar/my-project"))))
+
 (deftest ->range-test
   (testing "should subtract 1 from row and col values"
     (is (= {:start {:line      1
@@ -14,4 +18,4 @@
                     :character 0}
             :end   {:line      0
                     :character 0}}
-           (shared/->range {:row 0 :end-row 0 :col 0 :end-col 0})))))
\ No newline at end of file
+           (shared/->range {:row 0 :end-row 0 :col 0 :end-col 0})))))