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,109 @@
                         (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
+             :test-like-ns-name? (suggest-aliases/test-like-ns-name? namespace-name)}]
+      (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 (->>
+                            ;; `sut` doesn't count as an alias here,
+                            ;; because it is common that N namespaces can be aliased as `sut`:
+                            (dissoc project-aliases 'sut)
+                            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 test-like-ns-name?]}
+                                                   (get-ns-info-from-file-with-caching lang file)
+                                                   ;; if this ns is test-like, it shouldn't generate alias suggestions,
+                                                   ;; otherwise clients will suggest test namespaces as a candidate for a given alias,
+                                                   ;; which is never what the user means:
+                                                   final-suggested-aliases (when-not test-like-ns-name?
+                                                                             (not-empty suggested-aliases))]
+                                               (cond-> namespace-name
+                                                 final-suggested-aliases
+                                                 (with-meta {:suggested-aliases final-suggested-aliases}))))
+                                           ignore-errors?))
+                                    (remove aliased-namespaces))
+        possible-aliases (->> non-aliased-namespaces
+                              (keep (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,36 @@
+(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 test-like-ns-name? [ns-sym]
+  (let [ns-str (str ns-sym)]
+    (boolean (or (string/ends-with? ns-str "-test")
+                 (let [fragments (string/split ns-str #"\.")
+                       last-fragment (last fragments)]
+                   (or (string/starts-with? last-fragment "t-")
+                       (string/starts-with? last-fragment "test-")
+                       (some #{"test" "unit" "integration" "acceptance" "functional" "generative"} fragments)))))))
+
+(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 (distinct fragments)))
+        v (into {}
+                (map (fn [segments]
+                       [(->> segments (string/join ".") (symbol)),
+                        [namespace-name]]))
+                fragments)]
+    (dissoc v namespace-name)))

test-resources/bar/ns/libspecs.clj

@@ -0,0 +1 @@
+(ns bar.ns.libspecs)

test-resources/foo/ns/libspecs.clj

@@ -0,0 +1 @@
+(ns foo.ns.libspecs)

test/refactor_nrepl/ns/libspecs_test.clj

@@ -0,0 +1,55 @@
+(ns refactor-nrepl.ns.libspecs-test
+  (:require
+   [clojure.java.io :as io]
+   [clojure.test :refer [are deftest is testing]]
+   [refactor-nrepl.ns.libspecs :as sut]))
+
+(def example-file
+  (-> "foo/ns/libspecs.clj" io/resource io/as-file))
+
+(def other-similarly-named-file
+  (-> "bar/ns/libspecs.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]}                 [example-file]                            '{foo         [refactor-nrepl.ns.libspecs-test/bar]
+                                                                              libspecs    [foo.ns.libspecs]
+                                                                              ns.libspecs [foo.ns.libspecs]}
+
+    "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 [`other]}          [example-file]                            '{libspecs    [refactor-nrepl.ns.libspecs-test/other],
+                                                                              ns.libspecs [foo.ns.libspecs]}
+
+    "If a namespace is already aliased, no extra aliases are suggested at all"
+    {'example '[foo.ns.libspecs]} [example-file]                            '{example [foo.ns.libspecs]}
+
+    "If a namespace is only aliased as `sut`, extra aliases are suggested as usual"
+    {'sut '[foo.ns.libspecs]}     [example-file]                            '{sut         [foo.ns.libspecs],
+                                                                              libspecs    [foo.ns.libspecs],
+                                                                              ns.libspecs [foo.ns.libspecs]}
+
+    "If two files can result in the same alias being suggested, both will be included"
+    {}                            [example-file other-similarly-named-file] '{libspecs    [foo.ns.libspecs
+                                                                                           bar.ns.libspecs],
+                                                                              ns.libspecs [foo.ns.libspecs
+                                                                                           bar.ns.libspecs]}))

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,49 @@
+(ns refactor-nrepl.ns.suggest-aliases-test
+  (:require
+   [clojure.test :refer [are deftest is testing]]
+   [refactor-nrepl.ns.suggest-aliases :as sut]))
+
+(deftest test-like-ns-name?
+  (are [input expected] (= expected
+                           (sut/test-like-ns-name? input))
+    'test       true
+    'tast       false
+    'a.test     true
+    'a.tast     false
+    'a-test     true
+    'a-ast      false
+    'b.a-test   true
+    'b.a-ast    false
+    't-foo      true
+    'bar.t-foo  true
+    'te-foo     false
+    'bar.te-foo false
+    'unit.foo   true
+    'foo.unit   true))
+
+(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]}))