Basic protocol support for vanilla JS objects via mori.extend

src/mori/mori.cljs

@@ -1,6 +1,6 @@
 (ns mori
   (:refer-clojure :exclude
-   [count distinct empty first second next rest seq conj cons find nth last assoc dissoc
+   [extend count distinct empty first second next rest seq conj cons find nth last assoc dissoc
     get-in update-in assoc-in fnil disj pop peek hash get empty? reverse
     take drop take-nth partition partition-all partition-by iterate
     into merge merge-with subvec
@@ -20,7 +20,8 @@
     meta with-meta vary-meta
     apply])
   (:use-macros [mori.macros :only [make-inspectable mori-export]])
-  (:require [clojure.set :as set]))
+  (:require [goog.object]
+            [clojure.set :as set]))
 
 (mori-export apply cljs.core/apply)
 (mori-export count cljs.core/count)
@@ -254,3 +255,116 @@
   cljs.core.Symbol
   cljs.core.PersistentQueue
   cljs.core.PersistentQueueSeq)
+
+;; =============================================================================
+;; JS Protocol support
+
+(defn extend-to-iassociative [obj methods]
+  (specify! obj
+    IAssociative
+    (-contains-key? [this k] (.call (aget methods "contains_key") this k))
+    (-assoc [this k v] (.call (aget methods "assoc") this k v))))
+
+(defn extend-to-icloneable [obj methods]
+  (specify! obj
+    ICloneable
+    (-clone [this] (.call (aget methods "clone") this))))
+
+(defn extend-to-icollection [obj methods]
+  (specify! obj
+    ICollection
+    (-conj [this o] (.call (aget methods "conj") this o))))
+
+(defn extend-to-icounted [obj methods]
+  (specify! obj
+    ICounted
+    (-count [this] (.call (aget methods "count") this))))
+
+(defn extend-to-iencodeclojure [obj methods]
+  (specify! obj
+    IEncodeClojure
+    (-js->clj [this options] (.call (aget methods "toClj") this options))))
+
+(defn extend-to-iencodejs [obj methods]
+  (specify! obj
+    IEncodeJS
+    (-clj->js [this] (.call (aget methods "toJS") this))))
+
+(defn extend-to-iequiv [obj methods]
+  (specify! obj
+    IEquiv
+    (-equiv [this obj] (.call (aget methods "equiv") this obj))))
+
+(defn extend-to-ihash [obj methods]
+  (specify! obj
+    IHash
+    (-hash [this] (.call (aget methods "hash") this))))
+
+(defn extend-to-iindexed [obj methods]
+  (specify! obj
+    IIndexed
+    (-nth [this k] (.call (aget methods "nth") this))
+    (-nth [this k not-found] (.call (aget methods "nth") this))))
+
+(defn extend-to-ikvreduce [obj methods]
+  (specify! obj
+    IKVReduce
+    (-kv-reduce [this f init] (.call (aget methods "reduce_kv") this f init))))
+
+(defn extend-to-ilookup [obj methods]
+  (specify! obj
+    ILookup
+    (-lookup [this k] (-lookup this k nil))
+    (-lookup [this k not-found] (.call (aget methods "lookup") this k not-found))))
+
+(defn extend-to-imap [obj methods]
+  (specify! obj
+    IMap
+    (-dissoc [this k] (.call (aget methods "dissoc") this k))))
+
+(defn extend-to-imeta [obj methods]
+  (specify! obj
+    IMeta
+    (-meta [this] (.call (aget methods "meta") this))))
+
+(defn extend-to-iseq [obj methods]
+  (specify! obj
+    ISeq
+    (-first [this] (.call (aget methods "first") this))
+    (-rest [this] (.call (aget methods "rest") this))))
+
+(defn extend-to-iseqable [obj methods]
+  (specify! obj
+    ISeqable
+    (-seq [this] (.call (aget methods "seq") this))))
+
+(defn extend-to-iwithmeta [obj methods]
+  (specify! obj
+    IWithMeta
+    (-with-meta [this new-meta] (.call (aget methods "withMeta") this new-meta))))
+
+(defn extend! [protocol-name obj methods]
+  (case protocol-name
+    "IAssociative" (extend-to-iassociative obj methods)
+    "ICloneable" (extend-to-icloneable obj methods)
+    "ICollection" (extend-to-icollection obj methods)
+    "ICounted" (extend-to-icounted obj methods)
+    "IEncodeClojure" (extend-to-iencodeclojure obj methods)
+    "IEncodeJS" (extend-to-iencodejs obj methods)
+    "IEquiv" (extend-to-iequiv obj methods)
+    "IHash" (extend-to-ihash obj methods)
+    "IIndexed" (extend-to-iindexed obj methods)
+    "IKVReduce" (extend-to-ikvreduce obj methods)
+    "ILookup" (extend-to-ilookup obj methods)
+    "IMap" (extend-to-imap obj methods)
+    "IMeta" (extend-to-imeta obj methods)
+    "ISeq" (extend-to-iseq obj methods)
+    "ISeqable" (extend-to-iseqable obj methods)
+    "IWithMeta" (extend-to-iwithmeta obj methods)
+    (throw (js/Error. (str "Cannot extend to " protocol-name)))))
+
+(defn ^:export extend [obj protocols]
+  (goog.object/forEach protocols 
+    (fn [val key o]
+      (extend! key obj val)))
+       obj)