ClojureScript alter-var-root

alter.clj

(ns my-project.alter
  (:refer-clojure :exclude [alter-var-root]))

(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)))))

alter_spec.cljc

(ns my-project.alter-spec
  #?(:clj (:refer-clojure :exclude [alter-var-root]))
  (#?(:clj :require :cljs :require-macros)
   [speclj.core :refer [describe it should= with]]
   [my-project.alter :refer [alter-var-root]])
  (:require [speclj.core]
            [speclj.run.standard]))

(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 #'my-project.alter-spec/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 my-project.alter-spec/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)))))

https://web.archive.org/web/20170630045817/http://blog.nberger.com.ar/blog/2015/09/18/more-portable-complex-macro-musing/