Add support for auto-prefixes via cljs.storm.instrumentAutoPrefixes

Author: jpmonettas

CHANGELOG.md

@@ -3,8 +3,12 @@
 ## master (unreleased)
 
 ### New Features
+
+    - Add support for auto-prefixes via cljs.storm.instrumentAutoPrefixes
         
 ### Changes 
+
+    - Instrumentation is enable by default unless cljs.storm.instrumentEnable is set to false
         
 ### Bugs fixed 
 

src/main/clojure/cljs/storm/emitter.cljc

@@ -1,29 +1,26 @@
 (ns cljs.storm.emitter
-  (:require [clojure.string :as str]))
-
-#?(:clj
-   (defn prefixes-for-prop-starting-with [prop-prefix]
-     (reduce-kv (fn [prefixes prop-name prop-val]
-                  (if (str/starts-with? prop-name prop-prefix)
-                    (->> (str/split prop-val #",")
-                         (map str/trim)
-                         (remove str/blank?)
-                         (into prefixes))
-                    prefixes))
-                []
-                (into {} (System/getProperties)))))
+  (:require [clojure.string :as str]
+            [cljs.storm.utils :as utils]))
 
 #?(:clj (def instrument-enable
-          (some-> (System/getProperty "cljs.storm.instrumentEnable")
-                  Boolean/parseBoolean))
+          (if-let [prop (System/getProperty "cljs.storm.instrumentEnable")]
+            (Boolean/parseBoolean prop)
+            true))
    :cljs (def instrument-enable nil))
 
+#?(:clj (def auto-prefixes?
+          (if-let [prop (System/getProperty "cljs.storm.instrumentAutoPrefixes")]
+            (Boolean/parseBoolean prop)
+            true))
+   :cljs (def auto-prefixes? nil))
+
 #?(:clj (def instrument-only-prefixes
-          (prefixes-for-prop-starting-with "cljs.storm.instrumentOnlyPrefixes"))
+          (cond-> (utils/prefixes-for-prop-starting-with "cljs.storm.instrumentOnlyPrefixes")
+            auto-prefixes? (into (utils/classpath-src-dirs-prefixes))))
    :cljs (def instrument-only-prefixes nil))
 
 #?(:clj (def instrument-skip-prefixes
-          (prefixes-for-prop-starting-with "cljs.storm.instrumentSkipPrefixes"))
+          (utils/prefixes-for-prop-starting-with "cljs.storm.instrumentSkipPrefixes"))
    :cljs (def instrument-skip-prefixes nil))
 
 #?(:clj (def instrument-skip-regex

src/main/clojure/cljs/storm/utils.cljc

@@ -116,3 +116,50 @@
 (defn original-source-form [env]
   (or (get-in env [:root-source-info :source-form]) ;; root form when called from vanilla cljs compiler
       (:shadow.build/root-form env))) ;; root form when called from shadow
+
+#?(:clj
+   (defn src-dir-root-namespaces [dir-file]
+     (let [dir-path (.getAbsolutePath dir-file)]  
+       (->> (file-seq dir-file)
+            (filterv (fn [f]
+                       (or (str/ends-with? (.getName f) ".clj")
+                           (str/ends-with? (.getName f) ".cljc"))))
+            (keep (fn [f]
+                    (let [f-path (-> (.getAbsolutePath f)
+                                     (.replace "\\" "/"))
+                          [_ top-dir] (re-find (re-pattern (str dir-path "/(.+?)/.*")) f-path)]
+                      (when top-dir
+                        (Compiler/demunge top-dir)))))
+            (into #{})))))
+
+#?(:clj
+   (defn classpath-src-dirs-root-namespaces []
+     (let [class-path (System/getProperty "java.class.path")
+           class-path-separator (System/getProperty "path.separator")
+           cp-dir-entries (->> (.split class-path class-path-separator)
+                               (mapv io/file)
+                               (filterv #(.isDirectory %)))]
+       (reduce (fn [root-namespaces cp-dir-file]
+                 (into root-namespaces (src-dir-root-namespaces cp-dir-file)))
+               #{}
+               cp-dir-entries))))
+
+#?(:clj
+   (defn classpath-src-dirs-prefixes []
+     (->> (classpath-src-dirs-root-namespaces)
+          (remove (fn [root-ns-name]
+                    (or (= "flow-storm" root-ns-name)
+                        (= "clojure" root-ns-name)
+                        (= "cljs" root-ns-name)))))))
+
+#?(:clj
+   (defn prefixes-for-prop-starting-with [prop-prefix]
+     (reduce-kv (fn [prefixes prop-name prop-val]
+                  (if (str/starts-with? prop-name prop-prefix)
+                    (->> (str/split prop-val #",")
+                         (map str/trim)
+                         (remove str/blank?)
+                         (into prefixes))
+                    prefixes))
+                []
+                (into {} (System/getProperties)))))