Extract the bulk of the info functionality to orchard

bbatsov · bbatsov · commit 531d980b524b · 2018-05-19T10:53:23.000+03:00
diff --git a/project.clj b/project.clj
@@ -7,7 +7,7 @@
             :url "http://www.eclipse.org/legal/epl-v10.html"}
 
   :dependencies [[org.clojure/tools.nrepl "0.2.13"]
-                 ^:source-dep [cider/orchard "0.2.0"]
+                 ^:source-dep [cider/orchard "0.3.0-SNAPSHOT"]
                  ^:source-dep [thunknyc/profile "0.5.2"]
                  ^:source-dep [mvxcvi/puget "1.0.2"]
                  ^:source-dep [fipp "0.6.12"]
diff --git a/src/cider/nrepl/middleware/debug.clj b/src/cider/nrepl/middleware/debug.clj
@@ -1,7 +1,7 @@
 (ns cider.nrepl.middleware.debug
   "Expression-based debugger for clojure code"
   {:author "Artur Malabarba"}
-  (:require [cider.nrepl.middleware.info :as info]
+  (:require [orchard.info :as info]
             [cider.nrepl.middleware.inspect :refer [swap-inspector!]]
             [cider.nrepl.middleware.pprint :as pprint]
             [cider.nrepl.middleware.stacktrace :as stacktrace]
diff --git a/src/cider/nrepl/middleware/info.clj b/src/cider/nrepl/middleware/info.clj
@@ -9,28 +9,48 @@
             [orchard.java :as java]
             [orchard.misc :as u]
             [orchard.meta :as m]
+            [orchard.info :as clj-info]
+            [orchard.eldoc :as eldoc]
             [cljs-tooling.info :as cljs-info]
             [orchard.spec :as spec]))
 
-(defn- resource-full-path [relative-path]
-  (io/resource relative-path (class-loader)))
+(declare format-response)
 
-(def see-also-data
-  (edn/read-string (slurp (io/resource "see-also.edn"))))
+(defn format-nested
+  "Apply response formatting to nested `:candidates` info for Java members."
+  [info]
+  (if-let [candidates (:candidates info)]
+    (assoc info :candidates
+           (zipmap (keys candidates)
+                   (->> (vals candidates) (map format-response))))
+    info))
 
-(defn info-clj
-  [ns sym]
-  (or
-   ;; it's a special (special-symbol?)
-   (m/special-sym-meta sym)
-   ;; it's a var
-   (m/var-meta (m/resolve-var ns sym))
-   ;; sym is an alias for another ns
-   (m/ns-meta (get (m/resolve-aliases ns) sym))
-   ;; it's simply a full ns
-   (m/ns-meta (find-ns sym))
-   ;; it's a Java class/member symbol...or nil
-   (java/resolve-symbol ns sym)))
+(defn blacklist
+  "Remove anything that might contain arbitrary EDN, metadata can hold anything"
+  [info]
+  (let [blacklisted #{:arglists :forms}]
+    (apply dissoc info blacklisted)))
+
+(defn format-response
+  [info]
+  (letfn [(forms-join [forms]
+            (->> (map pr-str forms)
+                 (str/join \newline)))]
+    (when info
+      (-> info
+          (merge (when-let [ns (:ns info)]
+                   {:ns (str ns)})
+                 (when-let [args (:arglists info)]
+                   {:arglists-str (forms-join args)})
+                 (when-let [forms (:forms info)]
+                   {:forms-str (forms-join forms)})
+                 (when-let [file (:file info)]
+                   (clj-info/file-info file))
+                 (when-let [path (:javadoc info)]
+                   (clj-info/javadoc-info path)))
+          format-nested
+          blacklist
+          u/transform-value))))
 
 (defn info-cljs
   [env symbol ns]
@@ -58,190 +78,36 @@
                   f))
                f)))))
 
-(defn info-java
-  [class member]
-  (java/member-info class member))
-
 (defn info
   [{:keys [ns symbol class member] :as msg}]
   (let [[ns symbol class member] (map u/as-sym [ns symbol class member])]
     (if-let [cljs-env (cljs/grab-cljs-env msg)]
       (info-cljs cljs-env symbol ns)
-      (let [var-info (cond (and ns symbol) (info-clj ns symbol)
-                           (and class member) (info-java class member)
+      (let [var-info (cond (and ns symbol) (clj-info/info ns symbol)
+                           (and class member) (clj-info/info-java class member)
                            :else (throw (Exception.
                                          "Either \"symbol\", or (\"class\", \"member\") must be supplied")))
-            var-key  (str (:ns var-info) "/" (:name var-info))
-            see-also (->> (get see-also-data var-key)
-                          (filter (comp resolve u/as-sym)))]
+            see-also (clj-info/see-also ns symbol)]
         (if (seq see-also)
           (merge {:see-also see-also} var-info)
           var-info)))))
 
-(defn resource-path
-  "If it's a resource, return a tuple of the relative path and the full resource path."
-  [x]
-  (or (if-let [full (resource-full-path x)]
-        [x full])
-      (if-let [[_ relative] (re-find #".*jar!/(.*)" x)]
-        (if-let [full (resource-full-path relative)]
-          [relative full]))
-      ;; handles load-file on jar resources from a cider buffer
-      (if-let [[_ relative] (re-find #".*jar:(.*)" x)]
-        (if-let [full (resource-full-path relative)]
-          [relative full]))))
-
-(defn file-path
-  "For a file path, return a URL to the file if it exists and does not
-  represent a form evaluated at the REPL."
-  [x]
-  (when (seq x)
-    (let [f (io/file x)]
-      (when (and (.exists f)
-                 (not (-> f .getName (.startsWith "form-init"))))
-        (io/as-url f)))))
-
-(defn file-info
-  [path]
-  (let [[resource-relative resource-full] (resource-path path)]
-    (merge {:file (or (file-path path) resource-full path)}
-           ;; Classpath-relative path if possible
-           (if resource-relative
-             {:resource resource-relative}))))
-
-(defn javadoc-info
-  "Resolve a relative javadoc path to a URL and return as a map. Prefer javadoc
-  resources on the classpath; then use online javadoc content for core API
-  classes. If no source is available, return the relative path as is."
-  [path]
-  {:javadoc
-   (or (resource-full-path path)
-       ;; [bug#308] `*remote-javadocs*` is outdated WRT Java
-       ;; 8, so we try our own thing first.
-       (when (re-find #"^(java|javax|org.omg|org.w3c.dom|org.xml.sax)/" path)
-         (format "http://docs.oracle.com/javase/%d/docs/api/%s"
-                 u/java-api-version path))
-       ;; If that didn't work, _then_ we fallback on `*remote-javadocs*`.
-       (some (let [classname (.replaceAll path "/" ".")]
-               (fn [[prefix url]]
-                 (when (.startsWith classname prefix)
-                   (str url path))))
-             @javadoc/*remote-javadocs*)
-       path)})
-
-;; TODO: Seems those were hardcoded here accidentally - we should
-;; probably provide a simple API to register remote JavaDocs.
-(javadoc/add-remote-javadoc "com.amazonaws." "http://docs.aws.amazon.com/AWSJavaSDK/latest/javadoc/")
-(javadoc/add-remote-javadoc "org.apache.kafka." "https://kafka.apache.org/090/javadoc/index.html?")
-
-(declare format-response)
-
-(defn format-nested
-  "Apply response formatting to nested `:candidates` info for Java members."
-  [info]
-  (if-let [candidates (:candidates info)]
-    (assoc info :candidates
-           (zipmap (keys candidates)
-                   (->> (vals candidates) (map format-response))))
-    info))
-
-(defn blacklist
-  "Remove anything that might contain arbitrary EDN, metadata can hold anything"
-  [info]
-  (let [blacklisted #{:arglists :forms}]
-    (apply dissoc info blacklisted)))
-
-(defn format-response
-  [info]
-  (letfn [(forms-join [forms]
-            (->> (map pr-str forms)
-                 (str/join \newline)))]
-    (when info
-      (-> info
-          (merge (when-let [ns (:ns info)]
-                   {:ns (str ns)})
-                 (when-let [args (:arglists info)]
-                   {:arglists-str (forms-join args)})
-                 (when-let [forms (:forms info)]
-                   {:forms-str (forms-join forms)})
-                 (when-let [file (:file info)]
-                   (file-info file))
-                 (when-let [path (:javadoc info)]
-                   (javadoc-info path)))
-          format-nested
-          blacklist
-          u/transform-value))))
-
 (defn info-reply
   [msg]
   (if-let [var-info (format-response (info msg))]
     var-info
     {:status :no-info}))
 
-(defn extract-arglists
-  [info]
-  (cond
-    (:special-form info) (->> (:forms info)
-                              ;; :forms contains a vector of sequences or symbols
-                              ;; which we have to convert the format employed by :arglists
-                              (map #(if (coll? %) (vec %) (vector %))))
-    (:candidates info) (->> (:candidates info)
-                            vals
-                            (mapcat :arglists)
-                            distinct
-                            (sort-by count))
-    :else (:arglists info)))
-
-(defn format-arglists [raw-arglists]
-  (map #(mapv str %) raw-arglists))
-
-(defn extract-ns-or-class
-  [{:keys [ns class candidates] :as info}]
-  (cond
-    ns {:ns (str ns)}
-    class {:class [(str class)]}
-    candidates {:class (map key candidates)}))
-
-(defn extract-name-or-member
-  [{:keys [name member candidates]}]
-  (cond
-    name {:name (str name)}
-    member {:member (str member)}
-    candidates {:member (->> candidates vals (map :member) first str)}))
-
-(defn extract-eldoc
-  [info]
-  (if-let [arglists (seq (-> info extract-arglists format-arglists))]
-    {:eldoc arglists :type "function"}
-    {:type "variable"}))
-
 (defn eldoc-reply
   [msg]
   (if-let [info (info msg)]
-    (merge (extract-ns-or-class info)
-           (extract-name-or-member info)
-           (extract-eldoc info)
-           {:docstring (:doc info)})
+    (eldoc/eldoc info)
     {:status :no-eldoc}))
 
 (defn eldoc-datomic-query-reply
-  [msg]
+  [{:keys [ns symbol] :as msg}]
   (try
-    (let [ns (read-string (:ns msg))
-          sym (read-string (:symbol msg))
-          query (if (symbol? sym)
-                  (deref (ns-resolve ns sym))
-                  (eval sym))
-          inputs (if (map? query)
-                   ;; query as map
-                   (or (:in query) "$")
-                   ;; query as vector
-                   (let [partitioned (partition-by keyword? query)
-                         index (.indexOf partitioned '(:in))]
-                     (if (= index -1)
-                       "$"
-                       (nth partitioned (+ 1 index)))))]
-      {:inputs (format-arglists [inputs])})
+    (eldoc/datomic-query ns symbol)
     (catch Throwable _ {:status :no-eldoc})))
 
 (defn handle-info [handler msg]
diff --git a/src/cider/nrepl/middleware/stacktrace.clj b/src/cider/nrepl/middleware/stacktrace.clj
@@ -2,7 +2,7 @@
   "Cause and stacktrace analysis for exceptions"
   {:author "Jeff Valk"}
   (:require [cider.nrepl.middleware.pprint :as pprint]
-            [cider.nrepl.middleware.info :as info]
+            [orchard.info :as info]
             [cider.nrepl.middleware.util.cljs :as cljs]
             [orchard.namespace :as namespace]
             [clojure.repl :as repl]
@@ -74,7 +74,7 @@
              :fn  (str/join "/" (cons fn anons))
              :var (str ns "/" fn)
              ;; Full file path
-             :file-url (or (some-> (info/info-clj 'user (symbol (str ns "/" fn)))
+             :file-url (or (some-> (info/info 'user (symbol (str ns "/" fn)))
                                    :file
                                    path->url
                                    u/transform-value)
diff --git a/test/clj/cider/nrepl/middleware/info_test.clj b/test/clj/cider/nrepl/middleware/info_test.clj
