Merge pull request #1 from eyelidlessness/develop

Initial implementation

.gitignore

@@ -0,0 +1,11 @@
+/target
+/classes
+/checkouts
+pom.xml
+pom.xml.asc
+*.jar
+*.class
+/.lein-*
+/.nrepl-port
+.hgignore
+.hg/

README.md

@@ -1 +1,46 @@
-# alter-var-root-cljs
+# alter-cljs
+
+A ClojureScript implementation of `alter-var-root`.
+
+## Usage
+
+```clojure
+(ns my-ns
+  (#?(:clj :require :cljs :require-macros) [alter-cljs.core :refer [alter-var-root]]))
+
+(alter-var-root whatever
+  (fn [x]
+    (do-something-to x)))
+```
+
+## Tests
+
+### Clojure
+
+```bash
+lein spec
+```
+
+### ClojureScript
+
+ClojureScript tests require PhantomJS. There is a [known issue](https://github.com/slagyr/speclj/issues/133) where compilation warnings will be thrown, but the tests still run as expected.
+
+```bash
+lein cljsbuild spec
+```
+
+## License
+
+DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE
+Version 2, December 2004
+
+Copyright (C) 2015 Trevor Schmidt <[email protected]>
+
+Everyone is permitted to copy and distribute verbatim or modified
+copies of this license document, and changing it is allowed as long
+as the name is changed.
+
+DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE
+TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+0. You just DO WHAT THE FUCK YOU WANT TO.

project.clj

@@ -0,0 +1,21 @@
+(defproject alter-cljs "0.1.0"
+  :description "A ClojureScript implementation of alter-var-root"
+  :url "https://github.com/eyelidlessness/alter-cljs"
+  :license {:name "WTFPL v2"
+            :url "http://www.wtfpl.net/"}
+  :dependencies [[org.clojure/clojure "1.7.0"]
+                 [org.clojure/clojurescript "1.7.228" :scope "provided"]]
+  :aliases {"spec" ["with-profile" "dev" "spec"]
+            "cljsbuild" ["with-profile" "dev" "cljsbuild"]}
+  :profiles {:dev {:dependencies [[speclj "3.3.1"]]
+                   :plugins [[lein-cljsbuild "1.1.2"]
+                             [speclj "3.3.1"]]
+                   :cljsbuild {:builds [{:source-paths ["src" "test"]
+                                         :compiler {:output-to "target/cljsbuild/alter-cljs.js"
+                                                    :optimizations :whitespace}
+                                         :notify-command ["phantomjs"
+                                                          "test/phantomjs_runner.js"
+                                                          "target/cljsbuild/alter-cljs.js"]}]
+                               :test-commands {"test" ["phantomjs"
+                                                       "test/phantomjs_runner.js"
+                                                       "target/cljsbuild/alter-cljs.js"]}}}})

src/alter_cljs/core.clj

@@ -0,0 +1,59 @@
+(ns alter-cljs.core
+  (: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)))))

test/alter_cljs/core_test.cljc

@@ -0,0 +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= should-throw with]]
+   [alter-cljs.core :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 #'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)))))

test/phantomjs_runner.js

@@ -0,0 +1,22 @@
+#! /usr/bin/env phantomjs
+
+var fs = require('fs');
+var p = require('webpage').create();
+var sys = require('system');
+
+p.onConsoleMessage = function (x) {
+    fs.write('/dev/stdout', x, 'w');
+};
+
+p.injectJs(phantom.args[0]);
+
+var result = p.evaluate(function () {
+    speclj.run.standard.armed = true;
+    return speclj.run.standard.run_specs(
+        cljs.core.keyword('color'), true
+    );
+});
+
+p.close();
+
+phantom.exit(result);