Implementation

src/alter_cljs/core.clj

@@ -1,6 +1,59 @@
-(ns alter-cljs.core)
+(ns alter-cljs.core
+  (:refer-clojure :exclude [alter-var-root]))
 
-(defn foo
-  "I don't do a whole lot."
-  [x]
-  (println x "Hello, World!"))
+(defmacro if-cljs
+  "Return then if we are generating cljs code and else for Clojure code.
+   http://blog.nberger.com.ar/blog/2015/09/18/more-portable-complex-macro-musing"
+  [then else]
+  (if (:ns &env) then else))
+
+(def resolve-clj
+  (try clojure.core/resolve
+    (catch Exception _
+      (constantly nil))))
+
+(defmulti sym->var
+  (fn [env sym]
+    (cond
+      (contains? env sym) :clj
+      (resolve-clj sym) :clj-resolved
+      :else :cljs)))
+
+(defn meta->fq-sym [{:keys [ns name] :as m}]
+  (symbol (str (ns-name ns)) (str name)))
+
+(defmethod sym->var :clj [env sym]
+  (loop [init (-> env sym .-init)]
+    (cond
+      (instance? clojure.lang.Compiler$TheVarExpr init)
+      (-> init .-var meta meta->fq-sym)
+
+      (instance? clojure.lang.Compiler$LocalBindingExpr init)
+      (recur (-> init .-b .-init))
+
+      :default
+      nil)))
+
+(defmethod sym->var :clj-resolved [env sym]
+  (-> sym resolve meta meta->fq-sym))
+
+(defmethod sym->var :cljs [env sym]
+  (let [init (get-in env [:locals sym :init])
+        var-name (get-in init [:var :info :name])]
+      (cond
+        var-name var-name
+        (:form init) (recur (:env init) (:form init))
+        :else nil)))
+
+(defmacro alter-var-root [var-ref f]
+  (let [var-seq? (and (seq? var-ref) (= 'var (first var-ref)))
+        sym? (symbol? var-ref)
+        var-sym (cond
+                  var-seq? (second var-ref)
+                  sym? (sym->var &env var-ref)
+                  :else nil)]
+    (if (nil? var-sym)
+        `(throw (ex-info "Expected var" {:got ~var-ref}))
+        `(if-cljs
+           (set! ~var-sym (~f ~var-sym))
+           (clojure.core/alter-var-root (var ~var-sym) ~f)))))

test/alter_cljs/core_test.cljc

@@ -1,8 +1,64 @@
 (ns alter-cljs.core-test
+  #?(:clj (:refer-clojure :exclude [alter-var-root]))
   (#?(:clj :require :cljs :require-macros)
-   [speclj.core :refer [describe it should=]])
-  (:require [speclj.core]))
+   [speclj.core :refer [describe it should= should-throw with]]
+   [alter-cljs.core :refer [alter-var-root]])
+  (:require [speclj.core]
+            [speclj.run.standard]))
 
-(describe "testing"
-  (it "works"
-    (should= 0 0)))
+(def some-var :original)
+
+(def ex-type #?(:clj clojure.lang.ExceptionInfo :cljs ExceptionInfo))
+
+(describe "alter-var-root compatibility"
+  (it "alters the var"
+    (alter-var-root #'alter-cljs.core-test/some-var
+      (fn [original]
+        [original :modified]))
+    (should= some-var [:original :modified]))
+
+  (it "alters a var without specifying the namespace"
+    (alter-var-root #'some-var
+      (fn [original]
+        [original :modified-again]))
+    (should= some-var [[:original :modified] :modified-again]))
+
+  (it "alters a var named by symbol"
+    (alter-var-root alter-cljs.core-test/some-var
+      (fn [original]
+        [(first original) :modified-by-fq-sym]))
+    (should= some-var [[:original :modified] :modified-by-fq-sym]))
+
+  (it "alters a var named by symbol without specifying the namespace"
+    (alter-var-root some-var
+      (fn [original]
+        [(first original) :modified-by-sym]))
+    (should= some-var [[:original :modified] :modified-by-sym]))
+
+  (it "alters a var bound to a symbol"
+    (let [some-var-ref #'some-var]
+      (alter-var-root some-var-ref
+        (fn [original]
+          (first original)))
+      (should= some-var [:original :modified])))
+
+  (it "alters a var bound through several levels of indirection"
+    (let [some-var-ref #'some-var
+          some-mid-sym some-var-ref
+          some-sym some-mid-sym]
+      (let [nested some-sym]
+        (alter-var-root nested
+          (fn [original]
+            (first original)))
+          (should= some-var :original))))
+
+  (it "throws when trying to alter a non-var"
+    (let [some-sym :nope]
+      (should-throw ex-type
+        (alter-var-root some-sym identity))
+      (should-throw ex-type
+        (alter-var-root :some-kw identity))
+      (should-throw ex-type
+        (alter-var-root 0 identity))
+      (should-throw ex-type
+        (alter-var-root "a" identity)))))