dpp/template.cljs

## template.cljs
(ns portal.util.template
  (:require [goog.dom :as dom]
            [domina :as domina]
            [crate.core :as crate]
            [clojure.string :as s]
            ))

(def data
  "<html><body><div>hello <span id='moo' class='woo'>moo</span></div></body></html>")

;; Copied from Enfocus

(defn nodes->coll
  "coverts a nodelist, node into a collection"
  [nl]
  (if (identical? nl js/window)
    [nl]
    (domina/nodes nl)))


(defn html-to-dom [html]
  (let [dfa (nodes->coll (domina/html-to-dom html))
        frag (. js/document (createDocumentFragment))]
    (doseq [df dfa]
      (dom/append frag df))
    frag))

(def h (html-to-dom data))

(defprotocol ToHiccup
  (to-hiccup [value]))

(extend-protocol ToHiccup
  js/DocumentFragment
  (to-hiccup [frag] (to-hiccup (-> frag .-children first))))

(extend-protocol ToHiccup
  js/Element
  (to-hiccup [elem]
    (filterv
      identity
      (into
        [(keyword (.-localName elem))
         (to-hiccup (.-attributes elem))]
        (map to-hiccup (.-childNodes elem))
        ))))

;;; from http://stackoverflow.com/questions/28257750/how-to-convert-html-tag-with-style-to-hiccup-react-problems

(defn string->tokens
  "Takes a string with syles and parses it into properties and value tokens"
  [style]
  (->> (s/split style #";")
       (mapcat #(s/split % #":"))
       (map s/trim)))

(defn tokens->map
  "Takes a seq of tokens with the properties (even) and their values (odd)
   and returns a map of {properties values}"
  [tokens]
  (zipmap (keep-indexed #(if (even? %1) %2) tokens)
          (keep-indexed #(if (odd? %1) %2) tokens)))

(defn style->map
  "Takes an inline style attribute stirng and converts it to a React Style map"
  [style]
  (tokens->map (string->tokens style)))

;;; end-from

(extend-protocol ToHiccup
  js/NamedNodeMap
  (to-hiccup [attrs]
    (let [len (.-length attrs)]
      (if (= 0 len)
        nil
        (let [r (range 0 len)]
          (into
            {}
            (map
              (fn [i]
                (let [at (.item attrs i)
                      key (-> at .-name keyword)
                      value (-> at .-value)]
                  (if (= :style key)
                    [key (style->map value)]
                    [key value])
                  ))
              r))))
      )))

(extend-protocol ToHiccup
  js/Text
  (to-hiccup [text]
    (.-data text)))

(defn inner?
  "Does this command refer to the inner node?"
  [cmd]
  (let [cmd (name cmd)]
    (or (.includes cmd "inner")
        (.includes cmd "*"))
    ))

(defn append?
  "Is it an append command?"
  [cmd]
  (let [cmd (name cmd)]
    (.endsWith cmd ">")))

(defn prepend?
  "Is it a prepend command?"
  [cmd]
  (let [cmd (name cmd)]
    (.endsWith cmd "<")))

(defn remove?
  "Is it a remove command for attributes?"
  [cmd]
  (let [cmd (name cmd)]
    (.endsWith cmd "--")))

(defn hiccup?
  "tests to see if it's a Hiccup value"
  [val]
  (and
    (boolean val)
    (vector? val)
    (some-> val first keyword?)))

(defn node-from-hiccup
  "Take a Hiccup data structure and turn it into a DOM node"
  [hic]
  (crate/html hic))

(defn to-node
  "takes a data structure and converts it to a node.
  If it's a vec and not hiccup or a seq, then return
  a seq full of converted nodes"
  [data]
  (cond
    (instance? js/Node data) data
    (nil? data) data
    (string? data) (.createTextNode js/document data)
    (hiccup? data) (node-from-hiccup data)
    :else (throw (str "Can't create node from " (pr-str data)))
    ))

(defn to-doc-frag
  "Takes the data structure and turns it into a DocumentFragment"
  [data]
  (let [to-frag (fn [x]
                  (let [frag (. js/document (createDocumentFragment))]
                    (dom/append frag x)
                    frag))]
    (cond
      (instance? js/DocumentFragment data) data
      (instance? js/Node data) (to-frag data)
      (string? data) (html-to-dom data)
      (hiccup? data) (to-frag (node-from-hiccup data))
      :else (throw (str "Can't create document fragment from " (pr-str data)))
      )))


(declare alter)

(defn- alter-string
  [str cmd node] (alter (to-node str) cmd node))

(defn- alter-vec
  [vec cmd node]
  (if (hiccup? vec)
    (alter (to-node vec) cmd node)
    (alter (seq vec) cmd node)
    ))

(defn- alter-seq
  [the-seq cmd node]
  (if (hiccup? the-seq)
    (alter (to-node the-seq) cmd node)

    (let [nodes (map to-node the-seq)]
      (cond
        (inner? cmd)
        (cond
          (append? cmd)
          (doseq [new-node nodes]
            (.appendChild node new-node))

          (prepend? cmd)
          (doseq [new-node (reverse nodes)]
            (if (= 0 (count (.-childNodes node)))
              (.appendChild node new-node)
              (.insertBefore node new-node (.-firstChild node))
              ))

          :else
          (do
            (set! (.-innerHTML node) "")
            (doseq [new-node nodes]
              (.appendChild node new-node))
            ))

        (append? cmd)
        (doseq [new-node (reverse nodes)]
          (.insertBefore (.-parentElement node) new-node (.-nextSibling node)))

        (prepend? cmd)
        (doseq [new-node nodes]
          (.insertBefore (.-parentElement node) new-node node))

        :else
        (do
          (doseq [new-node nodes]
            (.insertBefore (.-parentElement node) new-node node))
          (.remove node)
          )

        )

      ))
  )

(defn- alter-nil
  [_ cmd node]
  (if (inner? cmd)
    (set! (.-innerHTML node) "")
    (.remove node))
  )
(defn- alter-func
  [the-fn cmd node]
  (if (-> the-fn meta :raw)
    (the-fn node cmd)
    (let [res (the-fn node cmd)]
      (cond
        (true? res)  node                                       ;; no-op
        (false? res) (alter nil cmd node)
        :else (alter res cmd node)))
    ))

(defn- alter-node
  [new-node cmd node]
  (if (identical? new-node node)
    node                                                    ;; no-op
    (cond
      (inner? cmd)
      (cond
        (append? cmd)
        (.appendChild node new-node)

        (prepend? cmd)
        (if (= 0 (count (.-childNodes node)))
          (.appendChild node new-node)
          (.insertBefore node new-node (.-firstChild node))
          )

        :else
        (do
          (set! (.-innerHTML node) "")
          (.appendChild node new-node)
          ))

      (append? cmd)
      (.insertBefore (.-parentElement node) new-node (-.nextSibling node))

      (prepend? cmd)
      (.insertBefore (.-parentElement node) new-node node)

      :else
      (do
        (.insertBefore (.-parentElement node) new-node node)
        (.remove node)
        )

      )

    )
  )


(defn- fixed-name
  "Fixes the name of the attribute key"
  [k]
  (let [k (name k)
        len (count k)]
    (cond
      (.endsWith k "--") (.substring k 0 (- len 2))
      (or
        (.endsWith k ">")
        (.endsWith k "<")) (.substring k 0 (- len 1))
      :else k)
    )
  )

(defn- alter-map
  "Deal with altering the attributes"
  [the-map cmd node]
  (let [attrs (.-attributes node)]
    (doseq [[key v] the-map]
      (let [k (fixed-name key)]
        (if (nil? v)
          (.removeNamedItem attrs k)
          (let [at (or (.getNamedItem attrs k)
                       (let [new-at (.createAttribute js/document k)]
                         (.setNamedItem attrs new-at)
                         new-at)
                       )
                old-str (.-value at)

                the-str (if (and (fn? v)
                                 (not (.startsWith k "on")))
                          (v old-str) v)
                the-str (if (= "class" k) (str " " the-str " ") the-str)
                new-str (cond
                          (append? key) (str old-str the-str)
                          (prepend? key) (str the-str old-str)
                          (remove? key) (.replace old-str (.trim the-str) "")
                          :else the-str)]
            (set! (.-value at) new-str)
            )
          )
        )

      ))
  )

(defn alter
  "Given a value, a command, and a node, do the right thing"
  [val cmd node]
  (cond
    (nil? val) (alter-nil val cmd node)
    (string? val) (alter-string val cmd node)
    (map? val) (alter-map val cmd node)
    (vector? val) (alter-vec val cmd node)
    (seq? val) (alter-seq val cmd node)
    (instance? js/Node val) (alter-node val cmd node)
    (fn? val) (alter-func val cmd node)
    :else (throw (pr-str [val cmd node])))
  )

(defn xform
  "Runs a series of css transforms on the dom and returns a Hicup data structure
  dom -- can be a String (converted into HTML), Hiccup (converted to html) or a js/Node
  cmds -- a series of 2 or 3 element vectors with [css-selector operation] [css-selector :command operation]

  Where css-selector is a string that contains a CSS selector
        command is :* (replace the inner HTML), :*> (append inner), :*< prepend inner, :! replace (default), :> append, :< prepend
        operation is string (text node), Hiccup template, DOM Node, map (keys and values are used to update the selected element's attributes, command ignored)
                     or a function that takes the command and the found node and returns a node to be run with the command
  "
  {:pre [(every? vector? funcs)]}
  [dom & funcs]

  (let [dom (to-doc-frag dom)]
    (doseq [[css cmd op] funcs]
      (let [[cmd op] (if (nil? op) [:! cmd] [cmd op])]
        (doseq [node (.querySelectorAll dom css)] (alter op cmd node))
        )
      )
    (to-hiccup dom)))
	(ns portal.util.template
	(:require [goog.dom :as dom]
	[domina :as domina]
	[crate.core :as crate]
	[clojure.string :as s]
	))

	(def data
	"<html><body><div>hello <span id='moo' class='woo'>moo</span></div></body></html>")

	;; Copied from Enfocus

	(defn nodes->coll
	"coverts a nodelist, node into a collection"
	[nl]
	(if (identical? nl js/window)
	[nl]
	(domina/nodes nl)))


	(defn html-to-dom [html]
	(let [dfa (nodes->coll (domina/html-to-dom html))
	frag (. js/document (createDocumentFragment))]
	(doseq [df dfa]
	(dom/append frag df))
	frag))

	(def h (html-to-dom data))

	(defprotocol ToHiccup
	(to-hiccup [value]))

	(extend-protocol ToHiccup
	js/DocumentFragment
	(to-hiccup [frag] (to-hiccup (-> frag .-children first))))

	(extend-protocol ToHiccup
	js/Element
	(to-hiccup [elem]
	(filterv
	identity
	(into
	[(keyword (.-localName elem))
	(to-hiccup (.-attributes elem))]
	(map to-hiccup (.-childNodes elem))
	))))

	;;; from http://stackoverflow.com/questions/28257750/how-to-convert-html-tag-with-style-to-hiccup-react-problems

	(defn string->tokens
	"Takes a string with syles and parses it into properties and value tokens"
	[style]
	(->> (s/split style #";")
	(mapcat #(s/split % #":"))
	(map s/trim)))

	(defn tokens->map
	"Takes a seq of tokens with the properties (even) and their values (odd)
	and returns a map of {properties values}"
	[tokens]
	(zipmap (keep-indexed #(if (even? %1) %2) tokens)
	(keep-indexed #(if (odd? %1) %2) tokens)))

	(defn style->map
	"Takes an inline style attribute stirng and converts it to a React Style map"
	[style]
	(tokens->map (string->tokens style)))

	;;; end-from

	(extend-protocol ToHiccup
	js/NamedNodeMap
	(to-hiccup [attrs]
	(let [len (.-length attrs)]
	(if (= 0 len)
	nil
	(let [r (range 0 len)]
	(into
	{}
	(map
	(fn [i]
	(let [at (.item attrs i)
	key (-> at .-name keyword)
	value (-> at .-value)]
	(if (= :style key)
	[key (style->map value)]
	[key value])
	))
	r))))
	)))

	(extend-protocol ToHiccup
	js/Text
	(to-hiccup [text]
	(.-data text)))

	(defn inner?
	"Does this command refer to the inner node?"
	[cmd]
	(let [cmd (name cmd)]
	(or (.includes cmd "inner")
	(.includes cmd "*"))
	))

	(defn append?
	"Is it an append command?"
	[cmd]
	(let [cmd (name cmd)]
	(.endsWith cmd ">")))

	(defn prepend?
	"Is it a prepend command?"
	[cmd]
	(let [cmd (name cmd)]
	(.endsWith cmd "<")))

	(defn remove?
	"Is it a remove command for attributes?"
	[cmd]
	(let [cmd (name cmd)]
	(.endsWith cmd "--")))

	(defn hiccup?
	"tests to see if it's a Hiccup value"
	[val]
	(and
	(boolean val)
	(vector? val)
	(some-> val first keyword?)))

	(defn node-from-hiccup
	"Take a Hiccup data structure and turn it into a DOM node"
	[hic]
	(crate/html hic))

	(defn to-node
	"takes a data structure and converts it to a node.
	If it's a vec and not hiccup or a seq, then return
	a seq full of converted nodes"
	[data]
	(cond
	(instance? js/Node data) data
	(nil? data) data
	(string? data) (.createTextNode js/document data)
	(hiccup? data) (node-from-hiccup data)
	:else (throw (str "Can't create node from " (pr-str data)))
	))

	(defn to-doc-frag
	"Takes the data structure and turns it into a DocumentFragment"
	[data]
	(let [to-frag (fn [x]
	(let [frag (. js/document (createDocumentFragment))]
	(dom/append frag x)
	frag))]
	(cond
	(instance? js/DocumentFragment data) data
	(instance? js/Node data) (to-frag data)
	(string? data) (html-to-dom data)
	(hiccup? data) (to-frag (node-from-hiccup data))
	:else (throw (str "Can't create document fragment from " (pr-str data)))
	)))


	(declare alter)

	(defn- alter-string
	[str cmd node] (alter (to-node str) cmd node))

	(defn- alter-vec
	[vec cmd node]
	(if (hiccup? vec)
	(alter (to-node vec) cmd node)
	(alter (seq vec) cmd node)
	))

	(defn- alter-seq
	[the-seq cmd node]
	(if (hiccup? the-seq)
	(alter (to-node the-seq) cmd node)

	(let [nodes (map to-node the-seq)]
	(cond
	(inner? cmd)
	(cond
	(append? cmd)
	(doseq [new-node nodes]
	(.appendChild node new-node))

	(prepend? cmd)
	(doseq [new-node (reverse nodes)]
	(if (= 0 (count (.-childNodes node)))
	(.appendChild node new-node)
	(.insertBefore node new-node (.-firstChild node))
	))

	:else
	(do
	(set! (.-innerHTML node) "")
	(doseq [new-node nodes]
	(.appendChild node new-node))
	))

	(append? cmd)
	(doseq [new-node (reverse nodes)]
	(.insertBefore (.-parentElement node) new-node (.-nextSibling node)))

	(prepend? cmd)
	(doseq [new-node nodes]
	(.insertBefore (.-parentElement node) new-node node))

	:else
	(do
	(doseq [new-node nodes]
	(.insertBefore (.-parentElement node) new-node node))
	(.remove node)
	)

	)

	))
	)

	(defn- alter-nil
	[_ cmd node]
	(if (inner? cmd)
	(set! (.-innerHTML node) "")
	(.remove node))
	)
	(defn- alter-func
	[the-fn cmd node]
	(if (-> the-fn meta :raw)
	(the-fn node cmd)
	(let [res (the-fn node cmd)]
	(cond
	(true? res) node ;; no-op
	(false? res) (alter nil cmd node)
	:else (alter res cmd node)))
	))

	(defn- alter-node
	[new-node cmd node]
	(if (identical? new-node node)
	node ;; no-op
	(cond
	(inner? cmd)
	(cond
	(append? cmd)
	(.appendChild node new-node)

	(prepend? cmd)
	(if (= 0 (count (.-childNodes node)))
	(.appendChild node new-node)
	(.insertBefore node new-node (.-firstChild node))
	)

	:else
	(do
	(set! (.-innerHTML node) "")
	(.appendChild node new-node)
	))

	(append? cmd)
	(.insertBefore (.-parentElement node) new-node (-.nextSibling node))

	(prepend? cmd)
	(.insertBefore (.-parentElement node) new-node node)

	:else
	(do
	(.insertBefore (.-parentElement node) new-node node)
	(.remove node)
	)

	)

	)
	)





	(defn- fixed-name
	"Fixes the name of the attribute key"
	[k]
	(let [k (name k)
	len (count k)]
	(cond
	(.endsWith k "--") (.substring k 0 (- len 2))
	(or
	(.endsWith k ">")
	(.endsWith k "<")) (.substring k 0 (- len 1))
	:else k)
	)
	)

	(defn- alter-map
	"Deal with altering the attributes"
	[the-map cmd node]
	(let [attrs (.-attributes node)]
	(doseq [[key v] the-map]
	(let [k (fixed-name key)]
	(if (nil? v)
	(.removeNamedItem attrs k)
	(let [at (or (.getNamedItem attrs k)
	(let [new-at (.createAttribute js/document k)]
	(.setNamedItem attrs new-at)
	new-at)
	)
	old-str (.-value at)

	the-str (if (and (fn? v)
	(not (.startsWith k "on")))
	(v old-str) v)
	the-str (if (= "class" k) (str " " the-str " ") the-str)
	new-str (cond
	(append? key) (str old-str the-str)
	(prepend? key) (str the-str old-str)
	(remove? key) (.replace old-str (.trim the-str) "")
	:else the-str)]
	(set! (.-value at) new-str)
	)
	)
	)

	))
	)

	(defn alter
	"Given a value, a command, and a node, do the right thing"
	[val cmd node]
	(cond
	(nil? val) (alter-nil val cmd node)
	(string? val) (alter-string val cmd node)
	(map? val) (alter-map val cmd node)
	(vector? val) (alter-vec val cmd node)
	(seq? val) (alter-seq val cmd node)
	(instance? js/Node val) (alter-node val cmd node)
	(fn? val) (alter-func val cmd node)
	:else (throw (pr-str [val cmd node])))
	)

	(defn xform
	"Runs a series of css transforms on the dom and returns a Hicup data structure
	dom -- can be a String (converted into HTML), Hiccup (converted to html) or a js/Node
	cmds -- a series of 2 or 3 element vectors with [css-selector operation] [css-selector :command operation]

	Where css-selector is a string that contains a CSS selector
	command is :* (replace the inner HTML), :> (append inner), :< prepend inner, :! replace (default), :> append, :< prepend
	operation is string (text node), Hiccup template, DOM Node, map (keys and values are used to update the selected element's attributes, command ignored)
	or a function that takes the command and the found node and returns a node to be run with the command
	"
	{:pre [(every? vector? funcs)]}
	[dom & funcs]

	(let [dom (to-doc-frag dom)]
	(doseq [[css cmd op] funcs]
	(let [[cmd op] (if (nil? op) [:! cmd] [cmd op])]
	(doseq [node (.querySelectorAll dom css)] (alter op cmd node))
	)
	)
	(to-hiccup dom)))