core.cljs

(ns fast.core
  (:refer-clojure :exclude [-next])
  (:require [css.units :as u]
    [cljs.pprint :as pprint]))

(def -UID (atom 0))
(defn new-uid [] (swap! -UID inc))

(defonce m-u-m (js/Array.))
(aset js/window "mum" m-u-m)

(defn indexed-iterate [col f]
  (let [c (count col)]
    (loop [i 0]
      (when (< i c)
        (f i (aget col i))
        (recur (inc i))))))

(defprotocol IUid
  (-uid [o])
  (-o [o]))

(defprotocol Node
  (-parent [o])
  (-native [o])
  (-idx [o])
  (-edn [o])
  (-children [o])
  (-nodes [o])
  (-path [o])
  (-next [o])
  (-prev [o])
  (-copy [o] [o parent])
  (-insert [o b idx])
  (-append [o col])
  (-prepend [o col])
  (-before [o col])
  (-after [o col])
  (-detach [o])
  (-cached [o k])
  (-delete [o]))

(defprotocol IStyleable
  (-styles [o])
  (-rules [o])
  (-blocks [o])
  (-add [o k v])
  (-mutate [o k])
  (-remove [o k])
  (-compute [o k])
  (-cascade [o k])
  (-cached [o k])
  (-purge [o k])
  (-store [o k v])
  (-update [o k f]))


(extend-type number
  IUid
  (-uid [o] (.valueOf o))
  (-o [o] (aget m-u-m (int o)))
  Node
  (-parent [o] (-parent (-o o)))
  (-native [o] (-native (-o o)))
  (-idx [o] (-idx (-o o)))
  (-edn [o] (-edn (-o o)))
  (-children [o] (-children (-o o)))
  (-nodes [o] (-nodes (-o o)))
  (-path [o] (-path (-o o)))
  (-next [o] (-next (-o o)))
  (-prev [o] (-prev (-o o)))
  (-copy [o] (.valueOf o))
  (-detach [o] (-detach (-o o)))

  (-insert [o b idx] (-insert (-o o) b idx))
  (-append [o col] (-append (-o o) col))
  (-prepend [o col] (-prepend(-o o) col))
  (-before [o col] (-before (-o o) col))
  (-after [o col] (-after (-o o) col))

  (-cached [o k] (-cached (-o o) k))
  (-delete [o] (-delete (-o o)))
  IStyleable
  (-styles [o] (-styles (-o o)))
  (-rules [o] (-rules (-styles o)))
  (-add [o k v] (-add (-styles o) k v))
  (-remove [o k] (-remove (-styles o) k))
  (-compute [o k] (-compute (-styles o) k))
  (-cascade [o k] (-cascade (-styles o) k))
  (-cached [o k] (-cached (-styles o) k))
  (-store [o k v] (-store (-styles o) k v))
  (-purge [o k] (-purge (-styles o) k))
  (-update [o k f] (-update (-styles o) k f))
  (-mutate [o k] (-mutate (-styles o) k)))

(extend-type nil
  IUid
  (-uid [o] nil)
  (-o [o] nil)
  Node
  (-copy
    ([o] nil)
    ([o _] nil))
  (-children [o] nil)
  (-edn [o] nil)
  (-nodes [o] nil)
  IStyleable
  (-styles [o] nil)
  (-rules [o] nil)
  (-add [o k v] nil)
  (-remove [o k] nil)
  (-compute [o k] nil)
  (-cascade [o k] nil)
  (-cached [o k] nil)
  (-purge [o k] nil)
  (-update [o k f] nil)
  (-mutate [o k] nil))

(extend-type string
  Node
  (-copy [o] (.valueOf o))
  (-edn [o] o))

(extend-type function
  Node
  (-copy [o] (.valueOf o)))

(extend-type default
  IUid
  (-uid [o] (.-uid o))
  (-o [o] o)
  Node
  (-parent [o] nil)
  (-native [o] nil)
  (-idx [o] nil)
  (-path [o] nil)
  (-children [o] nil)
  (-edn [o] (-edn (-o (-uid o))))
  (-nodes [o] nil)
  (-copy [o]
    (let [o2 (js/____c o)]
      (.map (js/locals o) #(aset o2 % (-copy (aget o %)))) o2))

  (-cached [o k] nil)
  (-delete [o] nil)
  (-detach [o] nil)
  (-insert [o b idx] nil))

(extend-type array
  Node
  (-edn [o] (js->clj o))
  (-copy [o]
    (let [o2 (js/____c o (.-length o))]
      (indexed-iterate o #(aset o2 %1 (-copy %2))) o2)))

(defn js-concat [v o]
  (.apply (.. js/Array -prototype -concat) v, o))

(defn -recur-up [node f]
  (let [res (js/Array.)]
    (loop [o node]
      (.push res (f o))
      (let [p (-parent o)]
        (if-not p res
          (recur p))))
    (.reverse res)))

(defn -recur-down [node f]
  (if (.-children node)
    (js-concat #js [ (f node)]
    (.map (.-children node)
      #(-recur-down (-o %) f)))
    #js [(f node)]))

(defn ->normalized-edn-map [col]
  (do (set! js/edn (with-out-str (pprint/write (into {} (map #(vector % (-edn %)) col))
    :dispatch pprint/code-dispatch))) true))

(defn ->quick-normalized [col]
  (do (set! js/edn (str  (into {} (map #(vector % (-edn %)) col)))) true))



;(time
;  (dotimes [n 1000]
;    (-compute (-o 1301) "font-size")))
;(time
;  (dotimes [n 1000]
;    (aget (-o 1301) "padding")))
;
;
;(time
;  (dotimes [n 1000]
;    (-update (-o 1301) "padding" #(u/+ % %))))
;
;

;(-remove (-o 1301) "vertical-align")
;(-add (-o 1301) "vertical-align" "baseline")
;(prn (-rules (-o 1301)))
;(.log js/console (-o 1301))
;(prn (-o 1824))
;
;(.debug js/console (reduce + (vals (-o 1824))))
;
;
;(let [vv (apply conj (vals (-o 1301)))]
;  (prn vv)
;  (prn (first vv))
;  (prn (nth vv 5))
;  (let [[a b c d] vv]
;    (prn [a b c d])))
;
;(prn (conj (-o 1824) (-o 1301)))
;
;(prn (conj {1824 (-o 1824)} {1301 (-o 1301)}))
;
;(prn (conj (-o  503) (-o 1824)))

element.cljs

(ns fast.element
  (:require
    [om.next :as om :include-macros true]
    [fast.core :refer [new-uid IUid IStyleable Node -o -uid -path  -copy -insert -append -prepend -before -after -delete -mutate
                       -next -prev -parent -detach -children -edn -nodes
                       -idx -native -styles -rules -add -remove -compute -cached -store -purge -update m-u-m -recur-up -recur-down
                       indexed-iterate]]
    [dollar.bill :as $ :refer [$]]
    [fast.style]
    [cljs.pprint :as pprint]
    [clojure.string :as string]
    [fp.refs :refer [doc-ref]]
    [fp.util :as util :refer [report]] ))

(declare Text Element with-native node-tree-path get-in-node-tree get-in-dom)
 
















(def _tokens (js/Array.))
(def _proxies (js/Array.))

(defn- re-index [uid]
  (let [col (.filter (.map (-children uid) -o) #(not (nil? %)))]
    (aset (-o uid) "children" (.map col -uid))
    (indexed-iterate col
      (fn [i c] (aset c "idx" i)))))

(defn update-tree-tokens [uid]
  (om/transact!
    (doc-ref :uid->token)
    #(conj %
      (into {}
        (-recur-down
          uid
          (fn [o]
            {(-uid o) {:uid      (-uid o)
                       :selected false
                       :expanded true
                       :target   false}}))))))











(defn o->vec-tree [uid]
  (let [o (-o uid)
        col (.-children o)]

    (if (instance? Text o)
      [(-uid o)]
      [(-uid o)
       (cond (vector? col)
         (mapv o->vec-tree col)
         (instance? js/Array col)
         (js->clj (.map col o->vec-tree))
         :else [])])))













(deftype Text [uid value]
  Object
  (toString [_] (js/htmlEncode value))
  (valueOf [this] value)
  IEquiv
  (-equiv [x o]
    (= value (aget o "value")))
  IUid
  (-uid [o] uid)
  (-o [o] o)
  IStyleable
  (-styles [o] nil)
  Node
  (-parent [o] (aget o "_parent"))
  (-native [o] (aget o "_native"))
  (-children [o] #js [])
  (-edn [o] 
    {:uid uid
     :parent (-parent o)
     :value value})
  (-idx [o]
    (or (when (-parent o)
          (.indexOf (-children (-parent o)) (-uid o)))
      0))
  (-path [o] (-recur-up o -idx))
  (-next [o] (-next (aget (.-children (-parent o)) (inc (-idx o)))))
  (-prev [o] (-prev (aget (.-children (-parent o)) (dec (-idx o)))))
  (-delete [o]
    (.removeChild (-native (-parent o)) (-native o))
    (aset m-u-m (-uid o) nil))
  (-copy [o] (let [fresh-uid (new-uid)
                   res (Text. fresh-uid value)]
               (aset m-u-m fresh-uid res)
               res))
  (-copy [o _parent]
    (let [res (-copy o)]
      (aset res "_parent" _parent)
      res)))









(defn- sync-appended [uid]
  (with-native (-o uid)
    (fn [co el]
      ;(prn (.map (-children co) #(type (-o %))))
      ;(.log js/console (.-childNodes el))
      (when (= 1 (.-nodeType el))
        (if (and (not= (.getAttribute el "uid") (str (-uid co))) (not= (.-uid el) (-uid co)))
          (.warn js/console "virtual dom desync: " el co)))
      (aset co "_native" el)
      (aset el "uid" (-uid co)))))






(deftype Element [uid start end children tag style ]
  Object
  (toString [o]
    (let [has-style? (pos? (count (aget (-o style) "_order")))]
      (str (:head start) " "
        (string/join ""
            (map
              (fn [[ak v]]
                (str ak (:start v) (:value v) (:end v)))
              ;(sort-by (comp :idx last)) 
              (remove 
                (comp {"" true " " true} :value last) 
                (if has-style?
                  (merge-with conj (:meat start)
                    {"style" {:start "=\"" :end "\"" :value (-o style) :idx (:idx (:meat start))}})
                  (:meat start)))))
            (:tail start)
            (.join (.map (-children o) (comp str -o)) "")
            end )))
  (valueOf [this] this)
  IPrintWithWriter
  (-pr-writer [o writer opts]
    (-write writer 
      (str "<" (.toLowerCase tag)
        (when (:id o) (str "#" (:id o)))
        (when-let [clist (re-seq #"[^ ]+" (or (:class o "")))]
          (apply str (mapcat #(list "." %) clist)))
        ">")))
  ILookup
  (-lookup [this k]
    (get-in (.-start this) [:meat (clj->js k) :value]))
  (-lookup [this k not-found]
    (let [v (get-in (.-start this) [:meat (clj->js k) :value] ::not-found)]
      (if-not (= v ::not-found)  v not-found)))
  IAssociative
  (-contains-key? [o k]
    (-contains-key? (:meat (.-start o)) k))
  (-assoc [o -k -v]
    (let [v (if (string? -v) -v (str -v))
          k (if (string? -k) -k (clj->js -k)) 
          attr (or (get-in (.-start o) [:meat k])
                    {:start "=\"" :end "\""})]
    (set! (.-start o) (update-in (.-start o) [:meat] conj {k (conj attr {:value v})}))
    (when (not= " " (last (:head (.-start o))))
      (set! (.-start o) (update-in (.-start o) [:head] #(str % " "))))
    (.setAttribute (-native o) k v)
    o))
  IMap
  (-dissoc [o -k]
    (let [k (if (string? -k) -k (clj->js -k))]
    (set! (.-start o) (update-in (.-start o) [:meat] dissoc k))
    (.removeAttribute (-native o) k) o))
  ISeqable
  (-seq [o] (seq 
    (conj (if (-styles o) {"style" (str (-styles o))} {}) 
      (into {} (map (juxt first (comp :value last)) (:meat (.-start o)))))))
  IMapEntry
  (-key [o] o)
  (-val [o] o)
  IUid
  (-uid [o] uid)
  (-o [o] o)
  IStyleable
  (-styles [o] (-o (.-style o)))
  (-rules [o] (-rules (-styles o)))
  (-add [o k v] (-add (-styles o) k v))
  (-remove [o k] (-remove (-styles o) k))
  (-compute [o k] (-compute (-styles o) k))
  (-cached [o k] (-cached (-styles o) k))
  (-purge [o k] (-purge (-styles o) k))
  (-store [o k v] (-store (-styles o) k v))
  (-update [o k f] (-update (-styles o) k f))
  (-mutate [o k] (-mutate (-styles o) k))
  Node
  (-parent [o] (aget o "_parent"))
  (-native [o] (aget o "_native"))
  (-children [o] (.-children o))
  (-edn [o] 
    {:uid uid
     :tag tag
     :parent (-parent o)
     :children (fp.util/by-key-vec :by-uid (js->clj (-children o)))
     :attrs (into {} (map (fn [[k v]] [(keyword k) (:value v)]) 
      (js->clj (conj (:meat start) 
        (if style {"style" {:value (fp.util/by-key-vec :by-uid [style])}} {})))))})
  (-nodes [o] (.filter (-children o) #(instance? Element (-o %))))
  (-idx [o]
    (or (when (-parent o) (.indexOf (-children (-parent o)) (-uid o)))
        0))
  (-path [o] (-recur-up o -idx))
  (-next [o] 
    (let [pns (-nodes (-parent o))
           ni (.indexOf pns (-uid o))]
               (if (= ni (.-length pns)) nil (aget pns (inc ni)))))
  (-prev [o] 
    (let [pns (-nodes (-parent o))
          ni (.indexOf pns (-uid o))]
      (if (= ni 0) nil (aget pns (dec ni)))))
  (-detach [o]
    (let [pth (-path (-parent o))
          idx (-idx o)
          uid (-uid o)]
      (.removeChild (.-parentElement (-native o)) (-native o))
      (fp.util/array-remove (-children (-parent o)) uid)
      (om/transact! @fp.data/RECONCILER 
        `[(std/update-in ~{:path [:dom/flat] :fn #(conj % fast.util/flat-dom-tree (-uid (-parent o)))}) 
          [:outliner][:selection][:style]])
      #_(om/transact! @fp.data/RECONCILER
      `[(std/update-in ~{:path [:uid->token] :fn #(dissoc % uid)}) ~[:uid->token uid] :outliner])
      o))
  (-delete [o]
    (-detach o)
    (.map
      (-recur-down o -uid)
      (fn [uid]
        #_(when (instance? Element (-o uid))
          (om/transact! (doc-ref :uid->token) #(dissoc % uid)))
        (aset m-u-m uid nil))))
  (-copy [o] (-copy o nil))
  (-copy [o _parent]
    (let [fresh-uid (new-uid)
          duplichilds (.map children (comp -uid #(-copy % fresh-uid) -o))
          res (Element. fresh-uid
                start end duplichilds tag (-uid (-copy (-o style) fresh-uid)))]
        (aset res "_parent" _parent)
        (aset res "_native" nil)
        (aset m-u-m fresh-uid res)
        (swap! fp.data/next-app update :uid->token 
          #(conj % {fresh-uid (conj (get (fp.refs/doc :uid->token) uid {}) {:uid fresh-uid})}))
        res))

  (-insert [o col idx]
    (if-let [target (get (-children o) idx)]
      (do (prn "target" target)
      (if-let [nxt (-next target)]
        (-before nxt col) (-append o col)))
      (-append o col)))

  (-append [o col]
    (let [chlds (-children o)
          elm (-native o)
          final-uids (js/Array.)
          res (for [thing col
                    :let [vo (-o thing)
                          uid (-uid vo)]
                    :when vo]
                (let [nel (first ($ (str vo)))]
                  ;(.log js/console "append" (str vo) vo nel)
                  (aset vo "_parent" (-uid o))
                  (aset vo "_native" nel)
                  (aset nel "uid" uid)
                  (.push chlds uid)
                  (.push final-uids uid)
                  (with-native (-o uid)
                    (fn [co el]
                      (aset co "_native" el)
                      (aset el "uid" (-uid co))) nel)
                  (.appendChild elm nel)
                  vo))]
      (js/freeze (-native (-parent o)))
      (om/transact! @fp.data/RECONCILER 
        `[(std/update-in ~{:path [:dom/flat] :fn #(conj % fast.util/flat-dom-tree (-uid (-parent o)))}) 
          [:outliner][:selection][:style]])))

  (-prepend [o col]
    (if-let [fo (aget (-children o) 0)]
      (-before fo col)
      (-append o col)))
  (-before [o col]
    (let [par (-o (-parent o))
          chlds (-children par)
          elm (-native par)
          final-uids (js/Array.)
          res (dorun (for [thing col
                    :let [vo (-o thing)
                          uid (-uid vo)]
                    :when vo]
                (let [nel (first ($ (str vo)))]
                  ;(.log js/console "before" vo nel)
                  (aset vo "_parent" (-parent o))
                  (aset vo "_native" nel)
                  (aset nel "uid" uid)
                  (.insertBefore elm nel (-native o))
                  (with-native (-o uid)
                    (fn [co el]
                      (aset co "_native" el)
                      (aset el "uid" (-uid co))) nel)
                  (.push final-uids uid)
                  vo)))]
      (aset par "children"
        (.concat (.slice chlds 0 (-idx o)) final-uids (.slice chlds (-idx o) (.-length chlds))))
      (js/freeze (-native (-parent o)))
      (om/transact! @fp.data/RECONCILER 
        `[(std/update-in ~{:path [:uid->token (-uid o)] :fn #(fast.util/ident-dom-tree 1)}) [:outliner][:selection][:style]])))
  (-after [o col]
    (if-let [no (-next o)]
      (-before no col)
      (-append (-parent o) col))))






















(defn nodelist->vec [nl]
  "TODO: don't remove empty textnodes beacuase of whitespace:pre"
  (let [len (.-length nl)]
    (vec (for [idx (range len)
          :let [node (.item nl idx)]
          ;:when (not (and (= 3 (.-nodeType node))
          ;             (re-find #"^[\W\?]*$"  (.-textContent node))))
               ]
      node))))




(defn start-tag [s] (re-find #"^\<[^>]*\>" s))
(defn end-tag [s] (re-find #"\<[^>]*\>$" s))
(defn attrs [s] (re-find #"(^\<[^\W]+\W*)(\w+\W*\=\W*[\"][^\"]*[\"])*" s))
(defn style-attr [s] (re-find #"([\w]*style\W*\=\W*\")([^\"]+)\"" s))
(defn attr-map [s]
  (into {}
    (map
      (fn [[_ head as vs qs]] {head {:value vs :start as :end qs}})
      (re-seq #"([^\s\=]+)([ \n\t]*\=[ \n\t]*[\"\'])([^\"\']*)([\"\'][ \n\t]*)" s))))

(defn tag-bread [s]
  (into {}
    (map
      (fn [[_ head meat tail]]
        {:head head :tail tail :meat (attr-map meat) })
      (re-seq #"^(\<[\w][\w\-\_]*)([^\>]*)(\>)$" s))))



 

(defn easy-node
  ([el] (easy-node el [] 0))
  ([el -path -idx]
    (let [uid (new-uid)
          path (conj -path uid)]
    (if (not= 1 (.-nodeType el))
      (let [res (Text. uid (.-textContent el) )]
        (aset res "_parent" (last -path))
        (aset res "_native" el)
        (aset m-u-m uid res)
        [uid])

    (let [s (.-outerHTML el)
          tag (.-tagName el)
          classes (.-className el)
          children (nodelist->vec (.-childNodes el))
          style-str (.. el -style -cssText)
          start (start-tag s)
          chopped-start (tag-bread start)
          -end (end-tag s)
          end (if (= start -end) "" -end)
          child-tokens (vec (map-indexed #(easy-node %2 path %1) children))
          _style (fast.style/style-set (or style-str "") uid)
          res (Element. uid chopped-start end (clj->js (mapv first child-tokens))
                tag (aget _style "uid") )]

      (aset res "_parent" (last -path))
      (aset res "_native" el)
      (aset el "uid" uid)
      (aset m-u-m uid res)
      (aset _proxies uid res)
      (aset _tokens uid {:uid uid
                         :selected false
                         :expanded (if (< (count path) 6) true false)
                         :target false})

      [uid child-tokens])))))























(defn get-in-dom [ks]
  (let [root (first (fp.util/$$ "body"))]
    (loop [path (rest ks)
           node root]
      (let []
        (cond (not (first path)) node
          (not node) nil
          :else
          (try
            (recur (rest path)
              (aget (.-childNodes node) (first path)))
            (catch js/Object e (prn "get-in-dom ERR:"[node path])))  )))))

(defn node-tree-path
  "turns a dom path into a node-tree path"
  [ks]
  (vec (rest (interpose 1 (js->clj ks)))))

(defn get-in-node-tree [ks]
  (get-in (doc-ref :nodes) (node-tree-path ks)))

(defn get-in-o [uid ks]
  (let [root (-o uid)]
    (loop [path (rest ks)
           node root]
      (let []
        (cond (not (first path)) node
          (not node) nil
          :else
          (try
            (recur (rest path)
              (-o (get (-children node) (first path))))
            (catch js/Object e nil))  )))))

(defn dom-walk-fn
  "calls f(path node) on each descendant"
  ([uid f]
    (let [o (-o uid)
          path (-path o)
          node (get-in-dom path)]
      (dom-walk-fn node f path)))
  ([node f path]
  (let [children (.-childNodes node)]
    (dorun (for [idx (range (.-length children))
                 :let [child (aget children idx)
                       path-clone (.slice path)
                       cpath (do (.push path-clone idx) path-clone)]
                 :when (= 1 (.-nodeType child))]
             (do (f child cpath)
                   (dom-walk-fn child f cpath)))))))


(defn with-native
  "invokes f on uid and native element, then recurs on children"
  ([uid f]
    (with-native uid f (get-in-dom (-path uid))))
  ([uid f node]
    (when-let [o (-o uid)]
    (let [node-children (.-childNodes node)]
      (f o node)
      (when (-children o)
        (dorun (for [idx (range (.-length node-children))
                     :let [o-child (aget (-children o) idx)
                           n-child (aget node-children idx)]
                     ;:when (= 1 (.-nodeType n-child))
                     ]
                 (with-native o-child f n-child))))))))


(defn mirror []
  (set! _tokens (js/Array.))
  (set! _proxies (js/Array.))
  (.groupCollapsed js/console "%cparsing DOM" "color: red;")
  (time 
  (let [tree (easy-node (first (util/$$ (util/active-doc-idx) "html")))
        tokens (into {} (.map _tokens #(identity {(:uid %) %})))
        proxies (into {} (map #(identity {% (aget _proxies %)}) (keys tokens)))]
    (.log js/console (str (.-length _proxies) " virtual elements"))
    (.log js/console _proxies)
    (.groupEnd js/console)
    [tree tokens proxies])))


(defn render-inner [uid]
  (report "rendering to HTML" "tomato")
  (time
  (let [o (-o uid)
        path (-path o)
        native (-native o)]
    (aset native "innerHTML" (apply str (map -o (.-children o))))
    (with-native uid
      (fn [o node]
        (aset o "_native" node)
        (aset node "uid" (-uid o)))))))



#_(aset js/window "show"
  (fn [uid] (prn {:uid uid
                  :children (aget (-o uid) "children")
                  :path (aget (-o uid) "path")
                  :-path (-path (-o uid))
                  :-idx (-idx (-o uid))
                  :idx (aget (-o uid) "idx")
                  :idx-path (aget (-o uid) "idx_path")
                  :native (-native (-o uid))
                  :style-uid (-uid (-styles (-o uid)))
                  :style (-styles (-o uid))})
                         ))

style.cljs

(ns fast.style
   (:require-macros
     [fp.macros :refer [js-iter]])
  (:require
    [fast.core :refer [new-uid IUid Node IStyleable -o -uid -path -edn -copy -parent -idx -native 
                       m-u-m -recur-up -rules -add -remove -update -cascade -mutate -blocks
                       -cached -purge -compute -store]]
    [clojure.string :as string]
    [goog.style :as gs]
    [css.units :as unit][css.spec]
    [fp.util]
    [dollar.bill :as $ :refer [$]]
    [sync.matrix]))

(defn remove! [o k] (goog.object.remove o k))

(declare Style StyleSet ValueSet)

(defonce css-symbol-map #js {})

(defn camel-style [el s] (gs/getVendorJsStyleName_ el s))

(defn get-cascaded [el -k]
  (assert (fp.util/jsElement? el) (str [el] " is not js/Element"))
  (let [k (camel-style el -k)
        rules (js/matchedCSS el)
        res (for [idx (range (.-length rules))
                  :let [rule (aget rules idx)
                        found (aget (.-style rule) k)]
                  :when (not= "" found)]
              found)] res))

(defn to-uvar [o]
  (case (aget o "type")
    "measure" (unit/new (aget o "value") (aget o "unit"))
    "color"   (unit/color o)
    "symbol"  (let [res (unit/Value. (.-value o))]
                (aset css-symbol-map (.-value o) res) res)
    "string"  (unit/Value. (.-string o))
    "url"     (unit/URL. o)
    "transform" (unit/Transform. o)
    (.log js/console o)))


(deftype ValueSet [array]
  Object
  (toString [o] (.join (aget o "array") " ")))

(defn parse-css-value [v]
  (or (try (.map (.parse js/CSS_value_parser v) to-uvar)
        (catch js/Object e ;(.warn js/console (str "CSS_value_parser_error: " v))
          )) 
      #js [v]))

(defn single-style [k v]
  (let [res (if (aget css-symbol-map v) #js [(-clone (aget css-symbol-map v))]
                (parse-css-value v))
        name (get css.spec/rewrite k k)
        stack (case (.-length res)
                0 nil
                1 (aget res 0)
                (ValueSet. res))]
    (Style. name stack)))

(defn style-set [s parent]
  (let [uid (new-uid)
        obj (StyleSet. uid parent #js[] nil)]
    (dorun (for [[_ k v] (re-seq #"\s*([^:;]+)\s*:\s*(url\(\s*[^\(]*\)|[^:;]+)" s)
                 :let [rname (string/trim k)
                       name (get css.spec/rewrite rname rname)
                       single (single-style name v)]]
             (do (aset obj name single)
                 (.push (.-_order obj) name))))
    (aset m-u-m uid obj)
    obj))











(deftype Style [rule value]
  Object
  (toString [_] (str rule ": " value ";"))
  (valueOf [this] (.valueOf value))
  Node
  (-edn [o] {(keyword rule) (str value)})
  IStyleable
  (-update [o k f]
    (if (instance? ValueSet value)
      (aset value "array" (.map (.-array value) f))
    (aset o "value" (f value))))
  ICounted
  (-count [_] (if (vector? value) (-count value) 1))
  ISeqable
  (-seq [this] (if (vector? value) (-seq value) (list value)))
  IIndexed
  (-nth [this n]
    (if (vector? value) (nth value n) (if (= n 0) value nil)))
  (-nth [this n not-found]
    (if (vector? value) (nth value n not-found) (if (= n 0) value not-found)))
  ILookup
  (-lookup [this k] (-lookup this k nil))
  (-lookup [this k not-found]
    (or (aget this (fp.util/kw->str k)) not-found))
  IEquiv
  (-equiv [x o]
    (if (instance? Style o)
      (and (= (.-rule o) (.-rule x))
        (= (.-value x) (.-value o)))
      (identical? x o)))
  ICollection
  (-conj [a b]
    (Style. rule (conj (.-value a) (.-value b)))))







(deftype CSSsheet [uid native blocks]
  Object
  (toString [o] (.join (.map blocks -o) "\n\n"))
  IUid
  (-uid [o] uid)
  (-o [o] o)
  Node
  (-native [o] native)
  (-parent [o] 
    (or (.-uid native) 
        (.log js/console "CSSsheet nil parent:" native)))
  (-edn [o] {
    :blocks (fp.util/by-key-vec :by-uid (vec blocks))
    :parent (-parent o)})
  IStyleable
  (-blocks [o] (aget o "blocks"))
  (-mutate [o k] 
    (when native (aset native "innerHTML" (str o)))))











(deftype StyleSet [uid parent _order selector]
  Object
  (toString [o] ;TODO need whitespace from PEG
    (if selector 
      (str selector "{\n  " (.join (-rules o) "\n  ") "\n}")
      (.join (-rules o) " "))) 
  IUid
  (-uid [o] uid)
  (-o [o] o)
  Node
  (-parent [o] (-o parent))
  (-native [o] (-native (-parent o)))
  (-edn [o] (conj 
    (if selector {:selector selector} {})
    {:parent parent
     :rules (mapv (fn [rule] (-edn (get o rule))) (js->clj _order))}))
  (-copy [o _parent]
    (let [fresh-uid (new-uid)
          res (-copy o)]
      (aset res "uid" fresh-uid)
      (aset res "parent" _parent)
      (aset m-u-m fresh-uid res)
      res))
  IStyleable
  (-styles [o] o)
  (-rules [o] (.map _order #(aget o %)))
  (-mutate [o k]
    (if selector 
      (when-let [source (-native parent)]
        (aset source "innerHTML" (str (-o parent))))
      (when (-native parent)
        (aset (.-style (-native parent)) k (.-value (aget o k))))))
  (-add [o k v]
    (let [rule (if (instance? Style v) v (single-style k v))]
      (let [name (.-rule rule)]
        (fp.util/array-unique-add _order name)
        (aset o name rule)
        (-mutate o name)
        rule)))
  (-remove [o k]
    (when (-contains-key? o k)
      (fp.util/array-remove _order k)
      (goog.object.remove o k)
      (aset (.-style (-native o)) k "")))
  (-compute [o k]
    (let [el (-native (-parent o))
          computed (.getComputedStyle (.-defaultView js/document) el nil)]
      (aget computed k)))
  (-cascade [o k] (first (get-cascaded (-native o) k)))
  (-update [o k f]
    (if-let [rule (aget o k)]
      (do (-update rule k f)
          (-mutate o k))
      (do (-update (-add o k (-compute o k)) k f)
          (-mutate o k))))
  (-cached [o k]
    (case k
      "boundingRect" 
      (or (aget o "boundingRect")
        (aset o "boundingRect"
          (sync.matrix/named-map->rectangle 
            (.getBoundingClientRect (-native o)))))
      (or (aget o k)
        (when-let [cmpt (-compute o k)]
          (-add o k cmpt)))))
  (-purge [o k]
    (case k
      "boundingRect" (remove! o k)))
  (-store [o k v] (aset o k v))

  ISeqable
  (-seq [o] (seq (for [idx (range (.-length _order))
                  :let [name (aget _order idx)
                        rule (aget o name)]]
              (vector name rule))))
  IMapEntry
  (-key [o] o)
  (-val [o] o)
  IAssociative
  (-contains-key? [o k] (.hasOwnProperty o k))
  (-assoc [o k v] (-add o (fp.util/kw->str k) v))
  IMap
  (-dissoc [o k] (-remove o (fp.util/kw->str k)))
  ILookup
  (-lookup [this k] (-lookup this k nil))
  (-lookup [this k not-found]
    (or (aget this (fp.util/kw->str k)) not-found))
  ICollection
  (-conj [a b]
    (into {} (concat (seq a) (seq b)))))











(defn mirror-css [document]
  (.groupCollapsed js/console "%cparsing CSS" "color:#0EB5BA;")
  (time 
  (let [uid-col #js []
        sheets (.-styleSheets document)
        res (into []
              (js-iter sheets sheet
                (let [sheet-uid (new-uid)
                      new-sheet (CSSsheet. sheet-uid (aget sheet "ownerNode")
                                  (if-let [rules (.-rules sheet)]
                                    (.filter
                                      (into-array
                                        (js-iter rules rule
                                          (when-let [sty (.-style rule)]
                                            (let [block-uid (new-uid)
                                                  new-block (StyleSet. block-uid sheet-uid #js [] (.-selectorText rule))]
                                              (dorun (js-iter sty k (-add new-block k (single-style k (aget sty k)))))
                                              (.push uid-col block-uid)
                                              (aset m-u-m block-uid new-block)
                                              block-uid))))
                                      #(not (nil? %)))
                                    #js []))]
                  (.push uid-col sheet-uid)
                  (aset m-u-m sheet-uid new-sheet)
                  new-sheet
                  )))]
    ;(.log js/console (into-array res))
    (.groupEnd js/console)   
    [res uid-col])))


(defn build-css-sheet [sheet]
  (let [
    sheet-uid (new-uid)
    new-sheet 
    (CSSsheet. sheet-uid (aget sheet "ownerNode")
      (if-let [rules (.-rules sheet)]
        (.filter
          (into-array
            (js-iter rules rule
              (when-let [sty (.-style rule)]
                (let [block-uid (new-uid)
                      new-block (StyleSet. block-uid sheet-uid #js [] (.-selectorText rule))]
                  (dorun (js-iter sty k (-add new-block k (single-style k (aget sty k)))))
                  (aset m-u-m block-uid new-block)
                  block-uid))))
          #(not (nil? %)))
        #js []))]
    (aset m-u-m sheet-uid new-sheet)
    new-sheet))


(defn get-style-sheet [document node]
  (let [sheets (.-styleSheets document)
        res (js-iter sheets sheet
          (if (= (.-ownerNode sheet) node) sheet))]
    (first (remove nil? res))))

util.cljs

(ns fast.util
  (:require
    [om.core :as om :include-macros true]
    [fast.core :refer 
      [new-uid IUid IStyleable Node -o -uid -path  -copy -insert -delete -next -prev -parent 
       -detach -children -idx -native -styles -rules -add -remove -compute -cached -purge 
       -update m-u-m -recur-up -recur-down -append -before indexed-iterate]]
    [clojure.set :refer [difference union intersection]]
    [dollar.bill :as $ :refer [$]]
    [fast.style]
    [fast.element]
    [fp.util]
    [fp.data]
    [clojure.string :as string]
    [fp.refs :refer [doc-ref]] ))



(def holders (js/Array.))

(defn element? [o] (instance? fast.element/Element (-o o)))
(defn node? [o] (or (element? o) (instance? fast.element/Text (-o o))))
(defn sheet? [o] (instance? fast.style/CSSsheet (-o o)))


(defn uid-path [uid]
  (-recur-up (-o uid) -uid))


(defn get-classes [uid]
  (if (element? uid)
    (if-let [s (:class (-o uid))]
      (clojure.string/split s #"[ ]+"))))

(defn- update-classes [uid f]
  (if (element? uid)
    (assoc (-o uid) :class 
      (clojure.string/join " " 
        (f (or (get-classes uid) []))))))

(defn add-class [uid s] (update-classes uid #(conj (set %) s)))
(defn remove-class [uid s] (update-classes uid #(disj (set %) s)))
(defn toggle-class [uid s] 
  (update-classes uid #(let [cs (set %)] (if (cs s) (disj cs s) (conj cs s)))))

(defn class-list [uid] (or (re-seq #"[^ ]+" (or (:class (-o uid) ""))) '()))
(defn conj-class! [uid s] 
  (assoc (-o uid) :class 
    (apply str (interpose " " (conj (set (class-list uid)) s)))))
(defn disj-class! [uid s] 
  (assoc (-o uid) :class 
    (apply str (interpose " " (disj (set (class-list uid)) s)))))


(defn o->el [uid] (first ($ (str (-o uid)))))

(defn s->el [s] (first ($ s)))

(defn selection-roots []
  (if-let [S (fp.refs/doc :selection/uids)]
    (if (not= :dom (fp.refs/doc :selection/mode)) []
        (filter #(every? nil? (map S (butlast (uid-path %)))) S))))

(defn selection-leafs []
  (if-let [S (fp.refs/doc :selection/uids)]
    (if (not= :dom (fp.refs/doc :selection/mode)) []
        (difference S (into #{} (map S (mapcat #(butlast (uid-path %)) S)))))))

(defn move-selection
  ([target] (move-selection target "inside"))
  ([target role]
    (let [roots (selection-roots)
          nodes (mapv -detach (remove nil? (map -o roots)))
          holder (if (= "inside" role) (-o target) (-o (-parent target)))]
      (cond (= "inside" role) (-append holder nodes)
        (= "after" role) (-before (-o target) nodes)
        (= "before" role) (-insert holder nodes (-idx (-o target)))))))

(defn duplicate-selection []
  ;TODO fix
  (om/update! (doc-ref :selection) :uids
    (set
      (map
        (fn [uid]
          (let [o (-o uid)
                p (-parent o)
                dup (-copy o (-uid p))]
            (-insert p [dup] (-idx o))
            (-uid dup)))
        (selection-roots)))))

(defn delete-selection []
    (mapv (comp -delete -o) (selection-roots))
    (om/update! (doc-ref :selection) :uids #{}))

(defn expanded-ancestor [uid]
  (let [tokens (fp.refs/doc :uid->token)
        res (or (:uid (first (drop-while #(true? (:expanded %))
                      (-recur-up uid #(get tokens (-uid %))) )))
                uid)]
          res))

(defn expand-to [uid]
  (let [tokens (doc-ref :uid->token)]
    (-recur-up uid
      #(when-let [token (get tokens (-uid %))]
        (when-not (:expanded token)
          (om/transact! tokens [(:uid token) :expanded] not))))))

(defn collapse-uids [uids]
  (om/transact! (doc-ref :uid->token) 
    (fn [tokens] (merge-with conj tokens (into {} (map #(vector % {:expanded false}) uids))))))



(defn measured-style? [o]
  (number? (.valueOf o)))

(defn sel [] (fp.refs/doc :selection/uids))


(defn dom-depth [uid] (dec (count (-recur-up (-o uid) #(identity 1)))))


(defn html-prn-str [uid]
  (let [o (-o uid)]
  (str "<span class='tag'>" (.toLowerCase (aget (-o uid) "tag")) "</span>"
        (when (:id o) 
          (str "<span class='id'>" "#" (:id o) "</span>"))
        (when-let [clist (re-seq #"[^ ]+" (or (:class o "")))]
          (apply str (mapcat #(list "." "<span class='class'>"  % "</span>") clist))))))


(defn flat-dom-tree [root]
  (try (vec (.filter (-recur-down (-o root) 
  #(when (aget % "tag") {:uid (-uid %) :depth (dom-depth %) 
    :children (let [res (.filter (-children %) element?)]
      (if (first res) (vec res) nil))} )) map?))
  (catch js/Error e (prn :bad-root))))

(defn ident-dom-tree [root]
  (into {} (map (juxt :uid identity) (.filter (-recur-down (-o root) 
  #(when (aget % "tag") {:uid (-uid %) :depth (dom-depth %) 
    :children (let [res (.filter (-children %) element?)]
      (fp.util/by-key-vec :dom/tree (vec res)))} )) map?))))

'(fp.util/debug :flat-nodes (flat-dom-tree 1))