middleware.info: offer new var-meta-allowlist option

Fixes #851

CHANGELOG.md

@@ -4,7 +4,9 @@
 
 ### Changes
 
+* Bump `orchard` to [0.23.0](https://github.com/clojure-emacs/orchard/blob/v0.23.0/CHANGELOG.md#0230-2024-03-03).
 * Bump `logjam` to [0.3.0](https://github.com/clojure-emacs/logjam/blob/v0.3.0/CHANGELOG.md#030-2024-03-03).
+* [#851](https://github.com/clojure-emacs/cider-nrepl/issues/851): `middleware.info`: offer new `var-meta-allowlist` option.
 
 ## Bugs fixed
 

project.clj

@@ -8,7 +8,7 @@
             :url "http://www.eclipse.org/legal/epl-v10.html"}
   :scm {:name "git" :url "https://github.com/clojure-emacs/cider-nrepl"}
   :dependencies [[nrepl "1.0.0"]
-                 [cider/orchard "0.22.0"]
+                 [cider/orchard "0.23.0"]
                  ^:inline-dep [mx.cider/haystack "0.3.3" :exclusions [cider/orchard]]
                  ^:inline-dep [thunknyc/profile "0.5.2"]
                  ^:inline-dep [mvxcvi/puget "1.3.4"]

src/cider/nrepl.clj

@@ -272,14 +272,17 @@ Depending on the type of the return value of the evaluation this middleware may
    "doc-block-tags-fragments"     (str "May be absent. Represent the 'param', 'returns' and 'throws' sections a Java doc comment. " fragments-desc)})
 
 (def info-params
-  {"sym"     "The symbol to lookup"
-   "ns"      "The current namespace"
-   "context" "A Compliment completion context, just like the ones already passed for the \"complete\" op,
+  {"sym"                "The symbol to lookup"
+   "ns"                 "The current namespace"
+   "context"            "A Compliment completion context, just like the ones already passed for the \"complete\" op,
 with the difference that the symbol at point should be entirely replaced by \"__prefix__\".
 For Java interop queries, it helps inferring the precise type of the object the `:sym` or `:member` refers to,
 making the results more accurate (and less numerous)."
-   "class"  "A Java class. If `:ns` is passed, it will be used for fully-qualifiying the class, if necessary."
-   "member" "A Java class member."})
+   "class"              "A Java class. If `:ns` is passed, it will be used for fully-qualifiying the class, if necessary."
+   "member"             "A Java class member."
+   "var-meta-allowlist" "The metadata keys from vars to be returned. Currently only affects `:clj`.
+Defaults to the value of `orchard.meta/var-meta-allowlist`.
+If specified, the value will be concatenated to that of `orchard.meta/var-meta-allowlist`."})
 
 (def-wrapper wrap-info cider.nrepl.middleware.info/handle-info
   (cljs/requires-piggieback

src/cider/nrepl/middleware/info.clj

@@ -8,6 +8,7 @@
    [clojure.string :as str]
    [orchard.eldoc :as eldoc]
    [orchard.info :as info]
+   [orchard.meta :as meta]
    [orchard.misc :as misc]))
 
 (declare format-response)
@@ -74,8 +75,11 @@
         ;; We can always be analyzing a broken context.
         nil))))
 
+(def var-meta-allowlist-set
+  (set meta/var-meta-allowlist))
+
 (defn info
-  [{:keys [ns sym class member context]
+  [{:keys [ns sym class member context var-meta-allowlist]
     legacy-sym :symbol
     :as msg}]
   (let [sym (or (not-empty legacy-sym)
@@ -108,7 +112,11 @@
                             :sym sym}
                            (when env
                              {:env env
-                              :dialect :cljs}))]
+                              :dialect :cljs})
+                           (when var-meta-allowlist
+                             {:var-meta-allowlist (into meta/var-meta-allowlist
+                                                        (remove var-meta-allowlist-set)
+                                                        var-meta-allowlist)}))]
     (cond
       java? (info/info-java class (or member sym))
       (and ns sym) (info/info* info-params)

test/clj/cider/nrepl/middleware/info_test.clj

@@ -82,6 +82,11 @@
                info/format-response
                (dissoc "file" "see-also"))))))
 
+(defn var-with-custom-meta
+  {:custom/meta 1}
+  [foo]
+  :bar)
+
 (deftest info-test
   ;; handle zero-length input
   (is (nil? (info/info {:ns (str (ns-name *ns*)) :sym ""})))
@@ -97,6 +102,16 @@
   (is (contains? (info/info {:ns (-> ::_ namespace str)
                              :sym "ns-resolve"})
                  :doc))
+
+  (testing "`:var-meta-allowlist`"
+    (let [base-keys [:ns :name :file :arglists :line :column]]
+      (is (= base-keys (keys (info/info {:ns (-> ::_ namespace str)
+                                         :sym "var-with-custom-meta"}))))
+      (is (= (conj base-keys :custom/meta)
+             (keys (info/info {:ns (-> ::_ namespace str)
+                               :sym "var-with-custom-meta"
+                               :var-meta-allowlist [:custom/meta]}))))))
+
   (is (= (info/info {:ns (-> ::_ namespace str)
                      :sym "ns-resolve"})
          (info/info {:ns (-> ::_ namespace str)