Implement :suggest option for the namespace-aliases op

Fixes #369

CHANGELOG.md

@@ -2,6 +2,9 @@
 
 ## Unreleased
 
+* [#369](https://github.com/clojure-emacs/refactor-nrepl/issues/369): Implement "suggest" option for the `namespace-aliases` op.
+  * This allows end-users to type [Stuart Sierra style](https://stuartsierra.com/2015/05/10/clojure-namespace-aliases) aliases and have them completed, even if this alias wasn't in use anywhere in a given codebase.
+
 ## 3.3.2
 
 * [#173](https://github.com/clojure-emacs/refactor-nrepl/issues/173): `rename-file-or-dir`: rename more kinds of constructs in dependent namespaces: namespace-qualified maps, fully-qualified functions, metadata.

README.md

@@ -316,6 +316,9 @@ project. The reply looks like this:
 ```
 The list of suggestions is sorted by frequency in decreasing order, so the first element is always the best suggestion.
 
+This op accepts a `:suggest` option, default falsey. If truthy, it will also include suggested aliases, following [Sierra's convention](https://stuartsierra.com/2015/05/10/clojure-namespace-aliases),
+for existing files that haven't been aliased yet. 
+
 ### find-used-publics
 
 In case namespace B depends on namespace A this operation finds occurrences of symbols in namespace B defined in namespace A.

src/refactor_nrepl/middleware.clj

@@ -6,7 +6,6 @@
    [refactor-nrepl.config :as config]
    [refactor-nrepl.core :as core]
    [refactor-nrepl.ns.libspec-allowlist :as libspec-allowlist]
-   [refactor-nrepl.ns.libspecs :refer [namespace-aliases]]
    [refactor-nrepl.stubs-for-interface :refer [stubs-for-interface]]))
 
 ;; Compatibility with the legacy tools.nrepl.
@@ -182,10 +181,15 @@
   (reply transport msg :touched (@rename-file-or-dir old-path new-path (= ignore-errors "true"))
          :status :done))
 
+(def namespace-aliases
+  (delay
+   (require-and-resolve 'refactor-nrepl.ns.libspecs/namespace-aliases-response)))
+
 (defn- namespace-aliases-reply [{:keys [transport] :as msg}]
-  (reply transport msg
-         :namespace-aliases (serialize-response msg (namespace-aliases))
-         :status :done))
+  (let [aliases (@namespace-aliases msg)]
+    (reply transport msg
+           :namespace-aliases (serialize-response msg aliases)
+           :status :done)))
 
 (def ^:private find-used-publics
   (delay (require-and-resolve 'refactor-nrepl.find.find-used-publics/find-used-publics)))

src/refactor_nrepl/ns/libspecs.clj

@@ -2,6 +2,7 @@
   (:require
    [refactor-nrepl.core :as core]
    [refactor-nrepl.ns.ns-parser :as ns-parser]
+   [refactor-nrepl.ns.suggest-aliases :as suggest-aliases]
    [refactor-nrepl.util :as util])
   (:import
    (java.io File)))
@@ -31,51 +32,99 @@
                         (mapv second aliases)])))
           grouped)))
 
-(defn- get-cached-libspec [^File f lang]
+(defn- get-cached-ns-info [^File f lang]
   (when-let [[ts v] (get-in @cache [(.getAbsolutePath f) lang])]
     (when (= ts (.lastModified f))
       v)))
 
-(defn- put-cached-libspec [^File f lang]
-  (let [libspecs (ns-parser/get-libspecs-from-file lang f)]
-    (swap! cache assoc-in [(.getAbsolutePath f) lang]
-           [(.lastModified f) libspecs])
-    libspecs))
+(defn- put-cached-ns-info! [^File f lang]
+  (binding [;; briefly memoize this function to avoid repeating its IO cost while `f` is being cached:
+            ns-parser/*read-ns-form-with-meta* (memoize core/read-ns-form-with-meta)]
+    (let [libspecs (ns-parser/get-libspecs-from-file lang f)
+          [_ namespace-name] (ns-parser/*read-ns-form-with-meta* lang f)
+          suggested-aliases (suggest-aliases/suggested-aliases namespace-name)
+          v {:libspecs libspecs
+             :namespace-name namespace-name
+             :suggested-aliases suggested-aliases}]
+      (swap! cache
+             assoc-in
+             [(.getAbsolutePath f) lang]
+             [(.lastModified f) v])
+      v)))
 
-(defn- get-libspec-from-file-with-caching [lang f]
-  (if-let [v (get-cached-libspec f lang)]
+(defn- get-ns-info-from-file-with-caching [lang f]
+  (if-let [v (get-cached-ns-info f lang)]
     v
-    (put-cached-libspec f lang)))
+    (put-cached-ns-info! f lang)))
+
+(defn- get-libspec-from-file-with-caching [lang f]
+  (:libspecs (get-ns-info-from-file-with-caching lang f)))
+
+(defn add-tentative-aliases [project-aliases lang files ignore-errors?]
+  (let [aliased-namespaces (->> project-aliases
+                                vals
+                                (reduce into [])
+                                (set))
+        non-aliased-namespaces (->> files
+                                    ;; note that we don't use pmap here -
+                                    ;; `files` was already iterated via `get-ns-info-from-file-with-caching`
+                                    ;; by the `#'namespace-aliases` defn:
+                                    (map (util/with-suppressed-errors
+                                           (fn [file]
+                                             (let [{:keys [namespace-name suggested-aliases]}
+                                                   (get-ns-info-from-file-with-caching lang file)]
+                                               (with-meta namespace-name
+                                                 {:suggested-aliases suggested-aliases})))
+                                           ignore-errors?))
+                                    (remove aliased-namespaces))
+        possible-aliases (->> non-aliased-namespaces
+                              (map (comp :suggested-aliases meta))
+                              (apply merge-with into))]
+    (->> project-aliases
+         keys
+         (apply dissoc possible-aliases)
+         (merge-with into project-aliases))))
 
 (defn namespace-aliases
   "Returns a map of file type to a map of aliases to namespaces
 
-  {:clj {util com.acme.util str clojure.string
-   :cljs {gstr goog.str}}}"
+  {:clj {util [com.acme.util]
+         str  [clojure.string]
+   :cljs {gstr [goog.str]}}}"
   ([]
    (namespace-aliases false))
   ([ignore-errors?]
    (namespace-aliases ignore-errors? (core/source-dirs-on-classpath)))
   ([ignore-errors? dirs]
+   (namespace-aliases ignore-errors? dirs false))
+  ([ignore-errors? dirs include-tentative-aliases?]
    (let [;; fetch the file list just once (as opposed to traversing the project once for each dialect)
          files (core/source-files-with-clj-like-extension ignore-errors? dirs)
          ;; pmap parallelizes a couple things:
-         ;;   - `pred`, which is IO-intentive
+         ;;   - `pred`, which is IO-intensive
          ;;   - `aliases-by-frequencies`, which is moderately CPU-intensive
-         [clj-files cljs-files] (pmap (fn [[dialect pred] corpus]
-                                        (->> corpus
-                                             (filter pred)
-                                             (map (partial get-libspec-from-file-with-caching dialect))
-                                             aliases-by-frequencies))
-                                      [[:clj (util/with-suppressed-errors
-                                               (some-fn core/clj-file? core/cljc-file?)
-                                               ignore-errors?)]
-                                       [:cljs (util/with-suppressed-errors
-                                                (some-fn core/cljs-file? core/cljc-file?)
-                                                ignore-errors?)]]
-                                      (repeat files))]
-     {:clj  clj-files
-      :cljs cljs-files})))
+         [clj-aliases cljs-aliases] (pmap (fn [[dialect pred] corpus]
+                                            (->> corpus
+                                                 (filter pred)
+                                                 (map (partial get-libspec-from-file-with-caching dialect))
+                                                 aliases-by-frequencies))
+                                          [[:clj (util/with-suppressed-errors
+                                                   (some-fn core/clj-file? core/cljc-file?)
+                                                   ignore-errors?)]
+                                           [:cljs (util/with-suppressed-errors
+                                                    (some-fn core/cljs-file? core/cljc-file?)
+                                                    ignore-errors?)]]
+                                          (repeat files))
+         project-aliases {:clj  clj-aliases
+                          :cljs cljs-aliases}]
+     (cond-> project-aliases
+       include-tentative-aliases? (update :clj  add-tentative-aliases :clj  files ignore-errors?)
+       include-tentative-aliases? (update :cljs add-tentative-aliases :cljs files ignore-errors?)))))
+
+(defn namespace-aliases-response [{:keys [suggest]}]
+  (namespace-aliases false
+                     (core/source-dirs-on-classpath)
+                     suggest))
 
 (defn- unwrap-refer
   [file {:keys [ns refer]}]

src/refactor_nrepl/ns/ns_parser.clj

@@ -119,6 +119,10 @@
    :ns (second (core/read-ns-form-with-meta path-or-file))
    :source-dialect (core/file->dialect path-or-file)))
 
+(def ^:dynamic *read-ns-form-with-meta* core/read-ns-form-with-meta)
+
+(alter-meta! #'*read-ns-form-with-meta* merge (-> core/read-ns-form-with-meta var meta (select-keys [:doc :arglists])))
+
 (defn get-libspecs-from-file
   "Return all the libspecs in a file.
 
@@ -134,7 +138,7 @@
   ([dialect ^File f]
    (some->> f
             .getAbsolutePath
-            (core/read-ns-form-with-meta dialect)
+            (*read-ns-form-with-meta* dialect)
             ((juxt get-libspecs get-required-macros))
             (mapcat identity))))
 

src/refactor_nrepl/ns/suggest_aliases.clj

@@ -0,0 +1,27 @@
+(ns refactor-nrepl.ns.suggest-aliases
+  "Suggestion of aliases based on these guidelines: https://stuartsierra.com/2015/05/10/clojure-namespace-aliases"
+  (:require
+   [clojure.string :as string]))
+
+(defn suggested-aliases [namespace-name]
+  (let [fragments (-> namespace-name str (string/split #"\."))
+        fragments (into []
+                        (comp (remove #{"core" "alpha" "api" "kws"})
+                              (map (fn [s]
+                                     (-> s
+                                         (string/replace "-clj" "")
+                                         (string/replace "clj-" "")
+                                         (string/replace "-cljs" "")
+                                         (string/replace "cljs-" "")
+                                         (string/replace "-clojure" "")
+                                         (string/replace "clojure-" "")))))
+                        fragments)
+        fragments (map take-last
+                       (range 1 (inc (count fragments)))
+                       (repeat fragments))
+        v (into {}
+                (map (fn [segments]
+                       [(->> segments (string/join ".") (symbol)),
+                        [namespace-name]]))
+                fragments)]
+    (dissoc v namespace-name)))

test/refactor_nrepl/ns/libspecs_test.clj

@@ -0,0 +1,45 @@
+(ns refactor-nrepl.ns.libspecs-test
+  (:require
+   [refactor-nrepl.ns.libspecs :as sut]
+   [clojure.test :refer [are deftest is testing]]
+   [clojure.string :as string]
+   [clojure.java.io :as io]))
+
+(def this-file
+  (-> ::_
+      namespace
+      (string/replace "." "/")
+      (string/replace "-" "_")
+      (str ".clj")
+      (io/resource)
+      (io/as-file)))
+
+(def unreadable-file
+  (-> "unreadable_file.clj" io/resource io/as-file))
+
+(deftest add-tentative-aliases-test
+
+  (testing "`ignore-errors?`"
+    (let [files [unreadable-file]]
+      (is (thrown? Exception (sut/add-tentative-aliases {} :clj files false)))
+      (is (= {}
+             (sut/add-tentative-aliases {} :clj files true)))))
+
+  (are [desc base input expected] (testing desc
+                                    (is (= expected
+                                           (sut/add-tentative-aliases base :clj input false)))
+                                    true)
+    #_base                    #_input     #_expected
+    "Doesn't remove existing aliases"
+    {'foo [`bar]}             []          {'foo [`bar]}
+
+    "Adds the two possible aliases for the given namespace"
+    {'foo [`bar]}             [this-file] {'foo              [`bar]
+                                           'libspecs-test    ['refactor-nrepl.ns.libspecs-test]
+                                           'ns.libspecs-test ['refactor-nrepl.ns.libspecs-test]}
+
+    "When an existing alias overlaps with a suggested alias,
+the original one is kept and no other semantic is suggested
+(this way, any given alias will point to one namespace at most)"
+    {'libspecs-test [`other]} [this-file] {'libspecs-test    [`other]
+                                           'ns.libspecs-test ['refactor-nrepl.ns.libspecs-test]}))

test/refactor_nrepl/ns/namespace_aliases_test.clj

@@ -33,11 +33,11 @@
 
 (deftest libspecs-are-cached
   (sut/namespace-aliases ignore-errors?)
-  (with-redefs [refactor-nrepl.ns.libspecs/put-cached-libspec
+  (with-redefs [refactor-nrepl.ns.libspecs/put-cached-ns-info!
                 (fn [& _] (throw (ex-info "Cache miss!" {})))]
     (is (sut/namespace-aliases ignore-errors?)))
   (reset! @#'sut/cache {})
-  (with-redefs [refactor-nrepl.ns.libspecs/put-cached-libspec
+  (with-redefs [refactor-nrepl.ns.libspecs/put-cached-ns-info!
                 (fn [& _] (throw (Exception. "Expected!")))]
     (is (thrown-with-msg? Exception #"Expected!"
                           (sut/namespace-aliases false)))))

test/refactor_nrepl/ns/suggest_aliases_test.clj

@@ -0,0 +1,31 @@
+(ns refactor-nrepl.ns.suggest-aliases-test
+  (:require
+   [clojure.test :refer [are deftest is testing]]
+   [refactor-nrepl.ns.suggest-aliases :as sut]))
+
+(deftest suggested-aliases
+  (are [desc input expected] (testing input
+                               (is (= expected
+                                      (sut/suggested-aliases input))
+                                   desc)
+                               (is (every? #{input}
+                                           (->> input
+                                                sut/suggested-aliases
+                                                vals
+                                                (reduce into [])))
+                                   "The values of the returned hashmap always contain exactly the given ns as-is")
+                               true)
+    "Returns nothing for a single-segment ns, because no alias can be derived from it"
+    'a              {}
+
+    "Returns one alias for a two-segment ns"
+    'a.b            '{b [a.b]}
+
+    "Returns two aliases for a three-segment ns"
+    'a.b.c          '{c   [a.b.c]
+                      b.c [a.b.c]}
+
+    "Removes redundant bits such as `clj-` and `.core`"
+    'clj-a.b.c.core '{c     [clj-a.b.c.core]
+                      b.c   [clj-a.b.c.core]
+                      a.b.c [clj-a.b.c.core]}))