Have DOM more or less working with element transitions, cursors implemented, working on items-view.

src/clojure/freactive/core.clj

@@ -95,3 +95,10 @@ return false or throw an exception."
    (atom-view ratom view-fn identity))
   ([ratom view-fn update-fn]
    (ReactiveAtomView. ratom view-fn update-fn)))
+
+(def rx* reactive*)
+
+(defmacro rx [& body]
+  `(freactive.core/rx*
+     (fn []
+       ~@body)))

src/clojure/freactive/core.cljs

@@ -18,17 +18,25 @@
 (defn remove-invalidation-watch [this key]
   (-remove-invalidation-watch this key))
 
+(defn- force-update-state [a old-value new-value]
+  (set! (.-state a) new-value)
+  (when-not (nil? (.-watches a))
+    (-notify-watches a old-value new-value))
+  (when-not (nil? (.-invalidation-watches a))
+    (-notify-invalidation-watches a))
+  new-value)
+
 (deftype ReactiveAtom [state meta validator watches invalidation-watches]
   Object
   (equiv [this other]
     (-equiv this other))
 
-  IAtom
+  cljs.core/IAtom
   
-  IEquiv
+  cljs.core/IEquiv
   (-equiv [o other] (identical? o other))
 
-  IDeref
+  cljs.core/IDeref
   (-deref [this]
     (register-dep this)
     state)
@@ -71,12 +79,8 @@
       (when-not (nil? validate)
         (assert (validate new-value) "Validator rejected reference state"))
       (let [old-value (.-state a)]
-        (set! (.-state a) new-value)
-        (when-not (nil? (.-watches a))
-          (-notify-watches a old-value new-value))
-        (when-not (nil? (.-invalidation-watches a))
-          (-notify-invalidation-watches a))
-        new-value)))
+        (when (not= old-value new-value)
+          (force-update-state a old-value new-value)))))
 
     ISwap
     (-swap! [a f]
@@ -179,3 +183,81 @@
   (let [reactive (ReactiveComputation. nil true f nil nil nil nil nil)]
     (set! (.-sully reactive) (make-sully-fn reactive))
     reactive))
+
+(defn- do-update-state [cursor new-value]
+  (let [old-value (.-state cursor)]
+    (when (not= old-value new-value)
+      (force-update-state cursor old-value new-value))))
+
+(deftype Cursor [ref path state meta watches invalidation-watches]
+  Object
+  (equiv [this other]
+    (-equiv this other))
+
+  cljs.core/IAtom
+
+  cljs.core/IEquiv
+  (-equiv [o other] (identical? o other))
+
+  cljs.core/IDeref
+  (-deref [this]
+    (register-dep this)
+    state)
+
+  IMeta
+  (-meta [_] meta)
+
+  IPrintWithWriter
+  (-pr-writer [a writer opts]
+    (-write writer "#<Cursor: ")
+    (pr-writer state writer opts)
+    (-write writer ">"))
+
+  IWatchable
+  (-notify-watches [this oldval newval]
+    (doseq [[key f] watches]
+      (f key this oldval newval)))
+  (-add-watch [this key f]
+    (set! (.-watches this) (assoc watches key f))
+    this)
+  (-remove-watch [this key]
+    (set! (.-watches this) (dissoc watches key)))
+
+  IHash
+  (-hash [this] (goog/getUid this))
+
+  IInvalidates
+  (-notify-invalidation-watches [this]
+    (doseq [[key f] invalidation-watches]
+      (f key this)))
+  (-add-invalidation-watch [this key f]
+    (set! (.-invalidation-watches this) (assoc invalidation-watches key f))
+    this)
+  (-remove-invalidation-watch [this key]
+    (set! (.-invalidation-watches this) (dissoc invalidation-watches key)))
+
+  IReset
+  (-reset! [a new-value]
+    (let [old-value (.-state a)]
+      (when (not= old-value new-value)
+        (swap! ref assoc-in path new-value)
+        (force-update-state cursor old-value new-value))))
+
+  ISwap
+  (-swap! [a f]
+    (do-update-state a (get-in (swap! ref update-in path f) path)))
+  (-swap! [a f x]
+    (do-update-state a (get-in (swap! ref update-in path f x) path)))
+  (-swap! [a f x y]
+    (do-update-state a (get-in (swap! ref update-in path f x y) path)))
+  (-swap! [a f x y more]
+    (do-update-state a (get-in (apply swap! ref update-in path f x y more) path))))
+
+(defn cursor [ref korks]
+  (let [path (if (keyword? korks) [korks] korks)
+        cursor (Cursor. ref path nil nil nil nil)]
+    (add-watch ref cursor
+      (fn [_ _ old-value new-value]
+        (do-update-state cursor (get-in new-value path))))
+    (set! (.-state cursor) (get-in @ref path))
+    cursor))

src/clojure/freactive/experimental.cljs

@@ -1,40 +1,38 @@
 (ns freactive.experimental)
 
-(defrecord ObservableCollection [state id-key])
+(deftype ObservableCollection [state auto-key observers])
 
 (declare do-txs)
 
-(defn- do-tx [state tx id-key]
+(defn- do-tx [state tx auto-key]
   (cond
     (map? tx)
-    (let [id (id-key tx)]
+    (let [id (auto-key)]
       [(assoc state id tx) [id tx]])
 
     (sequential? tx)
     (let [[id op & args] tx]
       (cond
         (sequential? id)
-        (do-txs state tx id-key)
+        (do-txs state tx auto-key)
 
         (map? op)
-        (let [op (assoc op id-key id)]
-          [(assoc state id op) [id op]])
+        [(assoc state id op) [id op]]
 
         (nil? op)
         [(dissoc state id) [id nil]]
 
         (ifn? op)
         (let [cur (get state id)
-              res (apply op cur args)
-              res (assoc res id-key id)]
+              res (apply op cur args)]
           [(assoc state id res) [id res]])))))
 
-(defn- do-txs [state txs id-key]
+(defn- do-txs [state txs auto-key]
   (loop [state state
          txs-res []
          [tx & txs] txs]
     (if tx
-      (let [[state tx-res] (do-tx state tx id-key)
+      (let [[state tx-res] (do-tx state tx auto-key)
             txs-res (if (sequential? (first tx-res))
                       (concat txs-res tx-res)
                       (conj txs-res tx-res))]
@@ -45,14 +43,15 @@
   (compare-and-set! atomic old-state new-state))
 
 (defn- notify-coll [coll txs-res]
-  txs-res)
+  (doseq [[k f] (.-observers coll)]
+    (f k coll txs-res)))
 
 (defn transact!* [coll tx-data]
-  (let [id-key (.-id-key coll)
+  (let [auto-key (.-auto-key coll)
         state (.-state coll)]
     (loop []
       (let [cur-state @state
-            [new-state txs-res] (do-txs cur-state tx-data id-key)]
+            [new-state txs-res] (do-txs cur-state tx-data auto-key)]
         (if (do-cas! state cur-state new-state)
           (notify-coll coll txs-res)
           (recur))))))
@@ -61,7 +60,7 @@
   (let [fst (first tx-data)]
     (cond
       (or (keyword? fst) (integer? fst) (string? fst))
-      (transact coll [tx-data])
+      (transact!* coll [tx-data])
 
       :default
       (apply transact!* coll tx-data))))
@@ -77,13 +76,26 @@
 ;; (transact! coll [0 assoc :a 1] [1 assoc :b 2])
 ;; (transact! coll [[0 assoc :a 1] [1 assoc :b 2]])
 
-(defn observable-coll
-  ([atomic & {:keys [id-key]
-              :or {id-key :id}}]
-   (ObservableCollection. atomic id-key)))
+(defn observable-collection
+  ([init & {:keys [auto-inc]}]
+   (let [init
+         (cond
+           (satisfies? cljs.core/IDeref init)
+           init
 
-(defn observe-coll [coll key f])
+           (map? init)
+           (atom init)
+
+           (sequential? init)
+           (atom (zipmap (range) init))
+
+           :default
+           (atom {}))]
+     (ObservableCollection. init
+       (when auto-inc
+         (fn [] (count @init)))
+       nil))))
+
+(defn observe-changes [coll key f]
+  (set! (.-observers coll) (assoc (.-observers coll) key f)))
 
-(defn cursor
-  ([atomic])
-  ([atomic korks]))

src/clojure/freactive/experimental/dom.cljs

@@ -1,7 +1,50 @@
 (ns freactive.experimental.dom
+  (:require-macros
+    [freactive.core :refer [rx]])
   (:require
     [freactive.core :as r]))
 
+(defprotocol IElement
+  (-get-element-spec [this])
+  (-get-dom-node [this])
+  (-set-dom-node [this nide])
+  (-get-transition [this transition-name])
+  (-set-transitions [this transitions]))
+
+(deftype Element [elem-spec dom-node transitions]
+  IElement
+  (-get-element-spec [_] elem-spec)
+  (-get-dom-node [_] dom-node)
+  (-set-dom-node [this node]
+    (set! (.-dom-node this) node))
+  (-get-transition [_ transition-name]
+    (get transitions transition-name))
+  (-set-transitions [this transitions]
+    (set! (.-transitions this) transitions)))
+
+(defn- as-element [elem-spec]
+  (if (satisfies? IElement elem-spec)
+    elem-spec
+    (Element. elem-spec nil nil)))
+
+(deftype DerefTransitionsWrapper [ref transitions])
+
+(defn with-transitions [elem & {:as transitions}]
+  (cond
+    (or (sequential? elem) (string? elem))
+    (Element. elem nil transitions)
+
+    (satisfies? IDeref elem)
+    (DerefTransitionsWrapper. elem transitions)
+
+    (satisfies? IElement elem)
+    (do
+      (-set-transitions elem transitions)
+      elem)
+
+    :default
+    (Element. elem nil transitions)))
+
 (defn request-animation-frame [f]
   (.requestAnimationFrame js/window f))
 
@@ -22,15 +65,15 @@
           (r/add-invalidation-watch ref key on-value-ref-invalidated)
           (set-fn element attr-name @ref))))))
 
-(defn- bind-style-prop! [element attr-name attr-value]
+(defn bind-style-prop! [element attr-name attr-value]
   (if (satisfies? cljs.core/IDeref attr-value)
     ((on-value-ref-invalidated* set-style-prop!) attr-value [element attr-name])
     (set-style-prop! element attr-name attr-value)))
 
-(defn- listen! [element evt-name handler]
+(defn listen! [element evt-name handler]
   (.addEventListener element evt-name handler))
 
-(defn- bind-attr! [element attr-name attr-value]
+(defn bind-attr! [element attr-name attr-value]
   (let [attr-name (name attr-name)]
     (cond
       (= "style" attr-name)
@@ -45,73 +88,125 @@
       :default
       (if (satisfies? cljs.core/IDeref attr-value)
         ((on-value-ref-invalidated* set-attr!) attr-value [element attr-name])
-        (set-attr! element attr-name attr-value)))))
+        ))))
 
 (defn- create-elem [kw]
   (.createElement js/document (name kw)))
 
 (declare build)
 
-(defn- convert-child [child]
+(defn- replace-child [parent new-elem cur-elem]
+  (if (and
+        cur-elem
+        (string? new-elem)
+        (= (.-nodeType cur-elem) 3))
+    (set! (.-textContent cur-elem) new-elem)
+    (let [new-elem (as-element new-elem)
+          new-node (build-node (-get-element-spec new-elem))
+          cur-node (when cur-elem (-get-dom-node cur-elem))]
+      (-set-dom-node new-elem new-node)
+      (let [parent (if (satisfies? IElement parent)
+                     (-get-dom-node parent)
+                     parent)]
+        (if cur-node
+          (.replaceChild parent new-node cur-node)
+          (.appendChild parent new-node)))
+      new-elem)))
+
+(defn- do-show-element [parent new-elem cur-elem show]
+  (let [new-elem (replace-child parent new-elem cur-elem)]
+    (when-let [show (or show (-get-transition new-elem :show))]
+      (show new-elem))
+    new-elem))
+
+(defn- transition-element
+  ([parent new-elem]
+   (transition-element parent new-elem nil nil nil))
+  ([parent new-elem {:keys [hide show] :as transitions}]
+   (transition-element parent new-elem nil hide show))
+  ([parent new-elem cur-elem hide show]
+   (if cur-elem
+     (if-let [hide (or hide (-get-transition cur-elem :hide))]
+       (hide cur-elem
+         (do-show-element parent new-elem cur-elem show))
+       (do-show-element parent new-elem cur-elem show))
+     (do-show-element parent new-elem cur-elem show))))
+
+(defn on-child-ref-invalidated* [parent [add-watch* remove-watch*]
+                                 {:keys [hide show] :as transitions}]
+  (fn on-child-ref-invalidated
+    ([key child-ref _ _]
+     (on-child-ref-invalidated key child-ref))
+    ([cur-elem child-ref]
+     (remove-watch* child-ref cur-elem)
+     (request-animation-frame
+       (fn [_]
+         (add-watch* child-ref cur-elem on-child-ref-invalidated)
+         (let [new-elem @child-ref
+               cur @cur-elem]
+           (when (or (not cur) (not= (-get-element-spec cur) new-elem))
+             (reset! cur-elem
+               (transition-element parent new-elem cur hide show)))))))))
+
+(defn- append-deref-child
+  [parent child transitions]
+  (if-let [watch-fns
+           (cond
+             (satisfies? freactive.core/IInvalidates child)
+             [r/add-invalidation-watch r/remove-invalidation-watch]
+
+             (satisfies? cljs.core/IWatchable child)
+             [add-watch remove-watch])]
+    ((on-child-ref-invalidated* parent watch-fns transitions) (atom nil) child)
+    (transition-element parent @child transitions)))
+
+(defn append-child! [parent child]
   (cond
-    (string? child)
-    (.createTextNode js/document child)
+    (instance? DerefTransitionsWrapper child)
+    (append-deref-child parent (.-ref child) (.-transitions child))
+
+    (satisfies? cljs.core/IDeref child)
+    (append-deref-child parent child nil)
 
     :default
-    child))
-
-(defn- append-child!* [parent child]
-  (let [child (convert-child child)]
-    (.appendChild parent child)
-    child))
-
-(defn- replace-child!* [parent new-child old-child]
-  (let [new-child (convert-child new-child)]
-    (.replaceChild parent new-child old-child)
-    new-child))
-
-(defn on-child-ref-invalidated* [parent]
-  (fn on-child-ref-invalidated
-    [cur-elem child-ref]
-    (r/remove-invalidation-watch child-ref cur-elem)
-    (request-animation-frame
-      (fn [_]
-        (r/add-invalidation-watch child-ref cur-elem on-child-ref-invalidated)
-        (let [new-elem @child-ref
-              cur @cur-elem]
-          (reset! cur-elem
-            (if cur
-              (replace-child!* parent new-elem cur)
-              (append-child!* parent new-elem))))))))
-
-(defn- append-child! [parent child]
-  (if
-    (satisfies? cljs.core/IDeref child)
-    ((on-child-ref-invalidated* parent) (atom nil) child)
-
-    (append-child!* parent child)))
+    (transition-element parent child)))
 
 (defn- append-children! [elem children]
   (doseq [ch children]
     (if (sequential? ch)
       (if (keyword? (first ch))
-        (append-child! elem (build ch))
+        (append-child! elem ch)
         (append-children! elem ch))
       (append-child! elem ch))))
 
-(defn build [elem-def]
-  (let [elem (create-elem (first elem-def))
-        attrs? (second elem-def)
-        attrs (when (map? attrs?) attrs?)
-        children (if attrs (nnext elem-def) (next elem-def))]
-    (doseq [[k v] attrs]
-      (bind-attr! elem k v))
-    (when children
-      (append-children! elem children))
-    elem))
+(defn build-node [elem-def]
+  (if (string? elem-def)
+    (.createTextNode js/document elem-def)
+    (let [elem (create-elem (first elem-def))
+          attrs? (second elem-def)
+          attrs (when (map? attrs?) attrs?)
+          children (if attrs (nnext elem-def) (next elem-def))]
+      (doseq [[k v] attrs]
+        (bind-attr! elem k v))
+      (when children
+        (append-children! elem children))
+      elem)))
+
+(defn- get-body []
+  (aget (.getElementsByTagName js/document "body") 0))
 
 (defn mount! [dom-element child]
   (append-child! dom-element child))
 
-(defn- get-body []
-  (aget (.getElementsByTagName js/document "body") 0))
+;(defn create-raw [elem-def]
+;  (let [elem-def
+;        (cond
+;          (keyword? elem-def)
+;          [elem-def]
+;
+;          :default
+;          elem-def)
+;        elem (as-element elem-def)
+;        node (build-node (-get-element-spec elem))]
+;    (-set-dom-node elem node)
+;    elem))

src/clojure/freactive/experimental/items_view.cljs

@@ -0,0 +1,56 @@
+(ns freactive.experimental.items-view
+  (:refer-clojure :exclude [atom])
+  (:require
+    [freactive.core :refer [atom]]
+    [freactive.experimental.dom :as dom]
+    [freactive.experimental :refer [observable-collection
+                                    observe-changes transact!]]))
+
+(deftype ItemsView [elem-spec dom-node transitions template-fn coll]
+  freactive.experimental.dom/IElement
+  (-get-element-spec [_] elem-spec)
+  (-get-dom-node [_] dom-node)
+  (-set-dom-node [this node]
+    (set! (.-dom-node this) node))
+  (-get-transition [_ transition-name]
+    (get transitions transition-name))
+  (-set-transitions [this transitions]
+    (set! (.-transitions this) transitions)))
+
+(defn items-view
+  [container template-fn items]
+  (let [coll
+        (cond
+          (instance? freactive.experimental/ObservableCollection items)
+          items
+
+          :default
+          (observable-collection items :auto-inc true))
+
+        container
+        (cond
+          (keyword? container)
+          [container]
+
+          :default
+          container)
+
+         view (ItemsView. container nil nil template-fn coll)
+
+         update-fn
+         (fn [view coll changes]
+           (doseq [[k v] changes]
+             (dom/append-child! view (template-fn (atom v)))))]
+
+    (dom/with-transitions
+      view
+      :show
+      (fn on-mount [view]
+        (println "coll" coll)
+        (update-fn view coll @(.-state coll))
+        (observe-changes coll view update-fn)))))
+
+
+(def c0 (observable-collection {:a "abc"}))
+
+(dom/mount! dom/root (items-view [:ul] (fn [x] [:li @x]) c0))

test/freactive/core_test.cljs

@@ -1,7 +1,7 @@
 (ns freactive.core-test
   (:refer-clojure :exclude [atom])
   (:require
-    [freactive.core :refer [atom rx*]]
+    [freactive.core :refer [atom cursor rx*]]
     [cemerick.cljs.test :refer-macros [deftest is]]))
 
 (deftest rx-test1
@@ -10,3 +10,15 @@
     (is (= 1 @r1))
     (swap! r0 inc)
     (is (= 2 @r1))))
+
+(deftest cursor-test
+  (let [a (atom {:a {:b 2}})
+        b (cursor a :a)
+        c (rx* (fn [] (inc (:b @b))))]
+    (is (= (:b @b) 2))
+    (swap! a update-in [:a :b] inc)
+    (is (= (:b @b) 3))
+    (is (= @c 4))
+    (swap! b update-in [:b] inc)
+    (is (:b @b 4))
+    (is (= @c 5))))