[Fix #47] Make find-symbol aware of macros

We use rewrite-clj to traverse the source files using zippers.  This means
we can can find macros in some situations where we cannot build an AST.

The current solution has the following limitations:

- No support for (:use ... :rename {the-macro new-name})
- The position data is for the macro name instead of the form containing
  the macro.  This is different from the result returned by analyzing the
  ast for functions.  As this only happens for the definition itself I
  don't see any negative consequences by this difference.

Author: expez

README.md

@@ -117,9 +117,7 @@ The return value is a stream of occurrences under the key `occurrence` which is
 
 `(:line-beg 5 :line-end 5 :col-beg 19 :col-end 26 :name a-name :file \"/aboslute/path/to/file.clj\" :match (fn-name some args))`
 
-When the fine `occurrence` has been send a final message is sent with `count`, indicating the total number of matches, and `status` `done`.
-
-In the event of an error the key `error` will contain a message which is intended for display to the user.
+When the final `occurrence` has been sent a final message is sent with `count`, indicating the total number of matches, and `status` `done`.
 
 #### find usages (application of find symbols)
 
@@ -294,6 +292,7 @@ build.sh cleans, runs source-deps with the right parameters, runs the tests and
 
 ## Changelog
 
+* Make `find-symbol` able to handle macros
 * Add `rename-file-or-dir` which returns a file or a directory of clj files.
 * Add `extract-definition` which returns enough information to the clien to afford inlining of defs defns and let-bound vars.
 * Add `stubs-for-interface` for creating skeleton interface implementations

project.clj

@@ -9,10 +9,11 @@
                  ^:source-dep [alembic "0.3.2"]
                  ^:source-dep [instaparse "1.3.6"]
                  ^:source-dep [org.clojure/tools.analyzer.jvm "0.6.6"]
-                 ^:source-dep [org.clojure/tools.namespace "0.2.7"]
+                 ^:source-dep [org.clojure/tools.namespace "0.2.10"]
                  ^:source-dep [org.clojure/tools.reader "0.8.12"]
                  ^:source-dep [org.clojure/java.classpath "0.2.2"]
-                 ^:source-dep [me.raynes/fs "1.4.6"]]
+                 ^:source-dep [me.raynes/fs "1.4.6"]
+                 ^:source-dep [rewrite-clj "0.4.12"]]
   :plugins [[thomasa/mranderson "0.4.3"]]
   :filespecs [{:type :bytes :path "refactor-nrepl/refactor-nrepl/project.clj" :bytes ~(slurp "project.clj")}]
   :profiles {:provided {:dependencies [[cider/cider-nrepl "0.8.2"]]}

src/refactor_nrepl/extract_definition.clj

@@ -1,8 +1,8 @@
 (ns refactor-nrepl.extract-definition
   (:require [clojure.string :as str]
-            [refactor-nrepl
-             [find-symbol :refer [create-result-alist find-symbol]]
-             [util :refer [get-enclosing-sexp]]]
+            [refactor-nrepl.find.find-symbol
+             :refer
+             [create-result-alist find-symbol]]
             [refactor-nrepl.ns.helpers :refer [suffix]]
             [refactor-nrepl.util :refer [get-enclosing-sexp get-next-sexp]])
   (:import [java.io PushbackReader StringReader]

src/refactor_nrepl/find/bindings.clj

@@ -0,0 +1,61 @@
+;; Taken from https://github.com/alexander-yakushev/compliment 0.2.4
+;; Copyright © 2013-2014 Alexander Yakushev. Distributed under the
+;; Eclipse Public License, the same as Clojure.
+(ns refactor-nrepl.find.bindings)
+
+(def ^:private let-like-forms
+  "Forms that create binding vector like let does."
+  '#{let if-let when-let if-some when-some})
+
+(def ^:private defn-like-forms
+  "Forms that create binding vector like defn does."
+  '#{defn defn- fn defmacro})
+
+(def ^:private doseq-like-forms
+  "Forms that create binding vector like doseq does."
+  '#{doseq for})
+
+(defn parse-binding
+  "Given a binding node returns the list of local bindings introduced by that
+  node. Handles vector and map destructuring."
+  [binding-node]
+  (cond (vector? binding-node)
+        (mapcat parse-binding binding-node)
+
+        (map? binding-node)
+        (let [normal-binds (->> (keys binding-node)
+                                (remove keyword?)
+                                (mapcat parse-binding))
+              keys-binds (if-let [ks (:keys binding-node)]
+                           (mapv str ks) ())
+              as-binds (if-let [as (:as binding-node)]
+                         [(str as)] ())]
+          (concat normal-binds keys-binds as-binds))
+
+        (not (#{'& '_} binding-node))
+        [(str binding-node)]))
+
+(defn extract-local-bindings
+  "When given a form that has a binding vector traverses that binding vector and
+  returns the list of all local bindings."
+  [form]
+  (when (list? form)
+    (cond (let-like-forms (first form))
+          (mapcat parse-binding (take-nth 2 (second form)))
+
+          (defn-like-forms (first form))
+          (mapcat parse-binding
+                  (loop [[c & r] (rest form), bnodes []]
+                    (cond (nil? c) bnodes
+                          (list? c) (recur r (conj bnodes (first c)))
+                          (vector? c) c
+                          :else (recur r bnodes))))
+
+          (doseq-like-forms (first form))
+          (->> (partition 2 (second form))
+               (mapcat (fn [[left right]]
+                         (if (= left :let)
+                           (take-nth 2 right) [left])))
+               (mapcat parse-binding))
+
+          :else #{})))

src/refactor_nrepl/find/find_macros.clj

@@ -0,0 +1,191 @@
+(ns refactor-nrepl.find.find-macros
+  (:import clojure.lang.LineNumberingPushbackReader
+           [java.io BufferedReader File FileReader StringReader])
+  (:require [clojure.string :as str]
+            [refactor-nrepl.ns
+             [helpers :as ns-helpers]
+             [ns-parser :as ns-parser]
+             [tracker :as tracker]]
+            [refactor-nrepl.util :as util]
+            [rewrite-clj.zip :as zip]
+            [refactor-nrepl.find.bindings :as bindings]))
+
+(defn- keep-lines
+  "Keep the first n lines of s."
+  [s n]
+  (->> s
+       StringReader.
+       java.io.BufferedReader.
+       line-seq
+       (take n)
+       doall
+       (str/join "\n")))
+
+(defn- build-macro-meta [form line-end path]
+  (let [file-content (slurp path)
+        file-ns (util/ns-from-string file-content)
+        content (keep-lines file-content line-end)
+        sexp (util/get-last-sexp content)
+        macro-name (name (second form))
+        col-beg (.indexOf sexp macro-name)]
+    {:name (str file-ns "/" macro-name)
+     :col-beg col-beg
+     :col-end (+ col-beg (.length macro-name))
+     :line-end line-end
+     :line-beg (inc (- line-end (count (str/split-lines sexp))))
+     :file (.getAbsolutePath path)
+     :match sexp}))
+
+(defn- find-macro-definitions-in-file
+  [path]
+  (let [rdr (LineNumberingPushbackReader. (FileReader. path))]
+    (loop [macros [], form (read rdr nil :eof)]
+      (cond
+        (= form :eof) macros
+        (= (first form) 'defmacro)
+        (recur (conj macros (build-macro-meta form (.getLineNumber rdr) path))
+               (read rdr nil :eof))
+        :else (recur macros (read rdr nil :eof))))))
+
+(defn- find-macro-definitions-in-project
+  "Finds all macros that are defined in the project."
+  []
+  (->> (util/find-clojure-sources-in-project)
+       (mapcat find-macro-definitions-in-file)))
+
+(defn- get-ns-aliases
+  "Create a map of ns-aliases to namespaces."
+  [libspecs]
+  (->>  libspecs
+        (map #((juxt (comp str :ns) (comp str :as)) %))
+        (into {})))
+
+(defn- referred-from-require?
+  [libspec macro-name]
+  (some->> (when (seq? (:refer libspec)) (:refer libspec))
+           (map str)
+           (filter #(= % (ns-helpers/suffix macro-name)))
+           first))
+
+(defn- referred-from-use?
+  [libspec macro-name]
+  (some->> libspec
+           :use
+           (map str)
+           (filter #(= % (ns-helpers/suffix macro-name)))
+           first))
+
+(defn- macro-referred? [libspecs macro-name]
+  (let [libspec (some->> libspecs
+                         (filter #(= (str (:ns %)) (ns-helpers/prefix macro-name)))
+                         first)]
+    (or (referred-from-require? libspec macro-name)
+        (referred-from-use? libspec macro-name))))
+
+(defn- node->occurrence
+  "line-offset is the offset in the file where we start searching.
+  This is after the ns but clj-rewrite keeps tracking of any following
+  whitespace."
+  [path macro-name line-offset zip-node]
+  (let [node (zip/node zip-node)
+        val (:string-value node)
+        {:keys [row col]} (meta node)]
+    {:match (zip/string (zip/up zip-node))
+     :name macro-name
+     :line-beg (dec (+ row line-offset))
+     :line-end (dec (+ row line-offset))
+     :col-beg (dec col)
+     :col-end (dec (+ col (.length val)))
+     :file path}))
+
+(defn- token-node? [node]
+  (= (zip/tag node) :token))
+
+(defn- macro-found?
+  [sym macro-name libspecs current-ns]
+  (let [macro-prefix (ns-helpers/prefix macro-name)
+        macro-suffix (ns-helpers/suffix macro-name)
+        alias? ((get-ns-aliases libspecs) macro-prefix)]
+    (or
+     ;; locally defined macro
+     (and (= current-ns macro-prefix)
+          (= sym macro-suffix))
+     ;; fully qualified
+     (= sym macro-name)
+     ;; aliased
+     (when alias? (= sym (str alias? "/" macro-suffix)))
+     ;; referred
+     (when (macro-referred? libspecs macro-name)
+       (= sym macro-suffix))
+     ;; I used to have a clause here for (:use .. :rename {...})
+     ;; but :use is ;; basically deprecated and nobody used :rename to
+     ;; begin with so I dropped it when the test failed.
+     )))
+
+(defn- active-bindings
+  "Find all the bindings above the current zip-node."
+  [zip-node]
+  (->> (zip/leftmost zip-node)
+       (iterate #(zip/up %))
+       (take-while identity)
+       (mapcat #(-> % zip/sexpr bindings/extract-local-bindings))
+       (into #{})))
+
+(defn- macro-shadowed? [macro-sym zip-node]
+  ((active-bindings zip-node) macro-sym))
+
+(defn- content-offset [path]
+  (-> path slurp util/get-next-sexp str/split-lines count))
+
+(defn- collect-occurrences
+  [occurrences macro ^File path zip-node]
+  (let [node (zip/node zip-node)
+        macro-name (str (:name macro))
+        sym (:string-value node)
+        path (.getAbsolutePath path)
+        ns-form (ns-helpers/read-ns-form path)
+        libspecs (ns-parser/get-libspecs ns-form)
+        current-ns (str (second ns-form))
+        offset (content-offset path)]
+    (when (and (macro-found? sym macro-name libspecs current-ns)
+               (not (macro-shadowed? sym zip-node)))
+      (swap! occurrences conj
+             (node->occurrence path macro-name offset zip-node))))
+  zip-node)
+
+(defn- find-usages-in-file [macro ^File path]
+  (let [zipper (-> path slurp ns-helpers/file-content-sans-ns zip/of-string)
+        occurrences (atom [])]
+    (zip/postwalk zipper
+                  token-node?
+                  (partial collect-occurrences occurrences macro path))
+    (loop [zipper (zip/right zipper)]
+      (when zipper
+        (zip/postwalk zipper
+                      token-node?
+                      (partial collect-occurrences occurrences macro path))
+        (recur (zip/right zipper))))
+    @occurrences))
+
+
+(defn- fully-qualified-name? [fully-qualified-name]
+  (when (ns-helpers/prefix fully-qualified-name)
+    fully-qualified-name))
+
+(defn find-macro
+  "Finds all occurrences of the macro, including the definition, in
+  the project."
+  [fully-qualified-name]
+  (when (fully-qualified-name? fully-qualified-name)
+    (let [all-defs (find-macro-definitions-in-project)
+          macro-def (first (filter #(= (:name %) fully-qualified-name) all-defs))
+          tracker (tracker/build-tracker)
+          origin-ns (symbol (ns-helpers/prefix fully-qualified-name))
+          dependents (tracker/get-dependents tracker origin-ns)]
+      (some->> macro-def
+               :file
+               File.
+               (conj dependents)
+               (mapcat (partial find-usages-in-file macro-def))
+               (into #{})
+               (remove nil?)))))

src/refactor_nrepl/find_symbol.clj renamed to src/refactor_nrepl/find/find_symbol.clj

@@ -1,10 +1,11 @@
-(ns refactor-nrepl.find-symbol
+(ns refactor-nrepl.find.find-symbol
   (:require [clojure.string :as str]
             [clojure.tools.analyzer.ast :refer [nodes postwalk]]
             [clojure.tools.namespace.find :refer [find-clojure-sources-in-dir]]
             [refactor-nrepl
              [analyzer :refer [ns-ast]]
-             [util :as util]]))
+             [util :as util]]
+            [refactor-nrepl.find.find-macros :refer [find-macro]]))
 
 (defn- node->var
   "Returns a fully qualified symbol for vars other those from clojure.core, for
@@ -166,11 +167,17 @@
                                (= local-var-name (-> % :name))
                                (:local %))))))))
 
+(defn to-find-symbol-result
+  [{:keys [line-beg line-end col-beg col-end name file match]}]
+  [line-beg line-end col-beg col-end name file match])
+
 (defn find-symbol [{:keys [file ns name dir line column]}]
   (util/throw-unless-clj-file file)
-  (or (when (and file (not-empty file))
-        (not-empty (find-local-symbol file name line column)))
-      (find-global-symbol file ns name dir)))
+  (or
+   ;; find-macro is first because find-global-symbol returns garb for macros
+   (some->> name find-macro (map to-find-symbol-result))
+   (and (seq file) (not-empty (find-local-symbol file name line column)))
+   (find-global-symbol file ns name dir)))
 
 (defn create-result-alist
   [line-beg line-end col-beg col-end name file match]

src/refactor_nrepl/find_unbound.clj renamed to src/refactor_nrepl/find/find_unbound.clj

@@ -1,4 +1,4 @@
-(ns refactor-nrepl.find-unbound
+(ns refactor-nrepl.find.find-unbound
   (:require [clojure.set :as set]
             [clojure.tools.analyzer.ast :refer [nodes]]
             [refactor-nrepl

src/refactor_nrepl/middleware.clj

@@ -9,11 +9,12 @@
              [artifacts :refer [artifact-list artifact-versions hotload-dependency]]
              [config :refer [configure]]
              [extract-definition :refer [extract-definition]]
-             [find-symbol :refer [create-result-alist find-debug-fns find-symbol]]
-             [find-unbound :refer [find-unbound-vars]]
              [plugin :as plugin]
              [rename-file-or-dir :refer [rename-file-or-dir]]
              [stubs-for-interface :refer [stubs-for-interface]]]
+            [refactor-nrepl.find
+             [find-symbol :refer [create-result-alist find-debug-fns find-symbol]]
+             [find-unbound :refer [find-unbound-vars]]]
             [refactor-nrepl.ns
              [clean-ns :refer [clean-ns]]
              [pprint :refer [pprint-ns]]

src/refactor_nrepl/ns/helpers.clj

@@ -60,6 +60,8 @@ type is either :require, :use or :import"
     (throw (IllegalArgumentException. "Malformed ns form!"))))
 
 (defn file-content-sans-ns [file-content]
+  ;; NOTE: It's tempting to trim this result but
+  ;; find-macros relies on this not being trimmed
   (let [rdr (PushbackReader. (StringReader. file-content))]
     (read rdr)
-    (str/triml (slurp rdr))))
+    (slurp rdr)))

src/refactor_nrepl/ns/require-or-use-or-import.bnf

@@ -12,14 +12,15 @@ prefix-libspec = open prefix (libspec-with-opts | suffix)+ close
 suffix = #"[A-Za-z0-9_?$%!-]+"
 libspec-with-opts = open ns opt* close
 <sym> = #"[A-Za-z0-9_?.$%&!/\;@^*<>:+=-]+"
-<opt> = as | refer | only | flag | rename
+<opt> = as | refer | only | flag | rename | exclude
 <only> = ':only' sym-vec
 <as> = ':as' sym
 <refer> = ':refer' (sym-vec | ':all')
 <rename> = ':rename' map
+<exclude> = ':exclude' sym-vec
 map = <'{'> entry* <'}'>
 <entry> = sym sym
-sym-vec = open sym+ close
+sym-vec = open sym* close
 <flag> = ':reload' | ':reload-all' | ':verbose'
 <open> = <'['> | <'('>
 <close> = <']'> | <')'>