fast.core

(ns fast.core
  (:require [css.units :as u]))

(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])
  (-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])
  (-add [o k v])
  (-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)))
  (-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)))

(extend-type nil
  IUid
  (-uid [o] nil)
  (-o [o] nil)
  Node
  (-copy
    ([o] nil)
    ([o _] nil))
  (-children [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))

(extend-type string
  Node
  (-copy [o] (.valueOf 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)
  (-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
  (-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)]))

fast.element

(ns fast.element
  (:require
    [om.core :as om :include-macros true]
    [fast.core :refer [new-uid IUid IStyleable Node -o -uid -path  -copy -insert -append -prepend -before -after -delete
                       -next -prev -parent -detach -children -nodes
                       -idx -native -styles -rules -add -remove -compute -cached -store -purge -update m-u-m -recur-up -recur-down
                       indexed-iterate]]
    [fast.style]
    [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 [_] 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 [])
  (-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) " uid=\"" uid "\" "
                  (string/join " "
                     (map
                       (fn [[ak v]]
                         (str ak (:start v) (:value v) (:end v)))
                       (if has-style?
                         (merge-with conj (:meat start)
                         {"style" {:start "=\"" :end "\" " :value (-o style)}})
                         (: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-not (= "" (.-className (-native o)))
                       (str "." (string/replace (.-className (-native o)) #"\W+" ".")))
                     ">")))
  IUid
  (-uid [o] uid)
  (-o [o] o)
  IStyleable
  (-styles [o] (-o style))
  (-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))
  Node
  (-parent [o] (aget o "_parent"))
  (-native [o] (aget o "_native"))
  (-children [o] (.-children o))
  (-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))]
               (cond (= ni (.-length pns)) nil
                 :else (aget pns (inc ni)))))
  (-prev [o] (let [pns (-nodes (-parent o))
                   ni (.indexOf pns (-uid o))]
               (cond (= ni 0) nil
                 :else (aget pns (dec ni)))))
  (-detach [o]
    (let [pth (-path (-parent o))
          idx (-idx o)]
      (.removeChild (.-parentElement (-native o)) (-native o))
      (fp.util/array-remove (-children (-parent o)) (-uid o))
      (om/transact! (doc-ref :nodes) (conj (node-tree-path pth) 1)  #(fp.util/slice % idx (inc idx)))
      ;(re-index (-parent o))
      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))
          (om/transact! (doc-ref :uid->proxy) #(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)
        (om/transact! (doc-ref :uid->token) #(conj % {fresh-uid (conj (get (doc-ref :uid->token) uid {}) {:uid fresh-uid } )}))
        (om/transact! (doc-ref :uid->proxy) #(conj % {fresh-uid res}))
        res))

  (-insert [o col idx]
    (if-let [target (get (-children o) idx)]
      (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 (fast.util/o->el 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)
                  (.appendChild elm nel)
                  vo))]
      (.map final-uids sync-appended)
      (js/freeze (-native (-parent o)))
      (om/transact! (doc-ref :nodes)
        (conj (node-tree-path (-path o)) 1)
        #(vec (concat % (map o->vec-tree res))))))
  (-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 (fast.util/o->el 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))
                  (.push final-uids uid)
                  vo)))]

      (aset par "children"
        (.concat (.slice chlds 0 (-idx o)) final-uids (.slice chlds (-idx o) (.-length chlds))))
      (.map final-uids sync-appended)
      (js/freeze (-native (-parent o)))
      (om/transact! (doc-ref :nodes)
        (conj (node-tree-path (-path par)) 1)
        #(apply fp.util/insert (concat [% (dec (-idx o))] (mapv o->vec-tree final-uids )) )
        ;#(mapv o->vec-tree (-children par))
        )))
  (-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*)([^\>]*)(\>)$" 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) 4) 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 []
  (def _tokens (js/Array.))
  (def _proxies (js/Array.))
  (.groupCollapsed js/console "parsing DOM")
  (let [tree (easy-node (first (util/$$ (util/active-doc-idx) "body")))
        tokens (into {} (.map _tokens #(identity {(:uid %) %})))
        proxies (into {} (map #(identity {% (aget _proxies %)}) (keys tokens)))]
    (.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)))))))

fast.style

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

(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]
  (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. (.-value o))
    "url"     (unit/URL. o)
    "transform" (unit/Transform. o)
    (.log js/console o)))


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


(defn single-style [k v]
  (let [res (if (aget css-symbol-map v) #js [(-clone (aget css-symbol-map 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]))
        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[])]
    (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 StyleSet [uid parent _order]
  Object
  (toString [o] (.join (-rules o) ""))
  IUid
  (-uid [o] uid)
  (-o [o] o)
  Node
  (-parent [o] (-o parent))
  (-native [o] (-native (-parent o)))
  (-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 %)))
  (-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)
        (aset (.-style (-native o)) name (str (.-value rule)))
        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]
    (when-let [rule (or (aget o k)
                    (-add o k (-compute o k)))]
      (-update rule k f)
      (aset (.-style (-native o)) (.-rule rule) (str (.-value rule)))))
  (-cached [o k]
    (case k
      "boundingRect" (or (aget o "boundingRect")
                         (aset o "boundingRect"
                           (let [br (.getBoundingClientRect (-native o))]
                             #js [(aget br "left")(aget br "top")(aget br "right")(aget br "bottom")(aget br "width")(aget br "height")])))
      (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))
  IEquiv
  (-equiv [x o]
    (if (instance? StyleSet o)
      (and (= (.. x -_order -length)
              (.. o -_order -length))
        (every? true? (map = (-rules x) (-rules o) )))
      (identical? x o)))
  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] (assoc o k v))
  IMap
  (-dissoc [o k] (dissoc o k))
  ILookup
  (-lookup [this k] (-lookup this k nil))
  (-lookup [this k not-found]
    (or (aget this (str k)) not-found))
  ICollection
  (-conj [a b]
    (into {} (concat (seq a) (seq b)))))


(deftype Style [rule value]
  Object
  (toString [_] (str rule ":" value ";"))
  (valueOf [this] (.valueOf 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)))
  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 blocks "\n\n"))
  IUid
  (-uid [o] uid)
  (-o [o] o)
  Node
  (-native [o] (aget native "ownerNode")))


(deftype CSSblock [uid parent selector _order]
  Object
  (toString [o] (str selector "{\n\t" (.join (-rules o) "\n\t") "\n}"))
  IUid
  (-uid [o] uid)
  (-o [o] o)
  Node
  (-parent [o] parent)
  (-native [o] (aget o "_native"))
  IStyleable
  (-styles [o] o)
  (-rules [o] (.map _order #(aget o %)))
  (-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)
        rule)))
  (-remove [o k]
    (when (-contains-key? o k)
      (fp.util/array-remove _order k)
      (goog.object.remove o k)))
  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] (assoc o k v))
  IMap
  (-dissoc [o k] (dissoc o k))
  ILookup
  (-lookup [this k] (-lookup this k nil))
  (-lookup [this k not-found]
    (or (aget this (str k)) not-found))
  ICollection
  (-conj [a b]
    (into {} (concat (seq a) (seq b)))))


(defn mirror-css [document]
  (.groupCollapsed js/console "parsing CSS")
  (let [sheets (.-styleSheets document)
        res (into []
              (js-iter sheets sheet
                (let [sheet-uid (new-uid)
                      new-sheet (CSSsheet. sheet-uid sheet
                                  (if-let [rules (.-rules sheet)]
                                    (.filter
                                      (into-array
                                        (js-iter rules rule
                                          (when-let [sty (.-style rule)]
                                            (let [block-uid (new-uid)
                                                  new-block (CSSblock. block-uid sheet-uid (.-selectorText rule) #js [])]
                                              (dorun (js-iter sty k (-add new-block k (single-style k (aget sty k)))))
                                              (aset m-u-m block-uid new-block)
                                              new-block))))
                                      #(not (nil? %)))
                                    #js []))]
                  (aset m-u-m sheet-uid new-sheet))))]
    (.groupEnd js/console)
    (.log js/console (into-array res))
    res))