amalantony/html-xml.clj

## html-xml.clj
(ns anthology.xhtml
  "XML/HTML emitter"
  (:require [clojure.string :as str]))

(defn- yoke [& xs] (apply str (flatten xs)))

(def escape-characters
  {\" "&quot;"
   \' "&apos;"
   \& "&amp;"
   \< "&lt;"
   \> "&gt;"})

(defn- parse-element
  [mode element attributes]
  (let [element (name element) selectors {"." "class" "#" "id"}]
    (if (= mode :xml)
      [element attributes]
      [(re-find #"[^\.#]+" element)
       (reduce (fn [m [_ k v]] (let [attr (selectors k)] (update m attr str (if (contains? m attr) \space) v)))
               (into {} (map (fn [[k v]] [(name k) v]) attributes))
               (re-seq #"([#\.])(\w+)" element))])))

(def void-elements
  "Set of void elements, as defined in HTML5 spec"
  #{"area" "base" "br" "col" "embed" "hr" "img" "input"
    "keygen" "link" "meta" "param" "source" "track" "wbr"})

(def declarations
  {:html "<!doctype html>" :xml "<?xml version=\"1.0\" ?>"})

(defn write-string
  "Emit HTML/XML document with the supplied contents. Supported options:
    :declaration - XML/HTML declaration (doctype), default depends on :mode
    :mode        - Emit mode, can be either :html or :xml"
  ([x] (write-string {} x))
  ([{:keys [declaration mode depth] :or {mode :html depth 0} :as options} x]
   (let [{:keys [declaration] :as options}
         {:declaration (if (some #{:declaration} (keys options)) declaration (declarations mode))
          :mode (if (contains? (set (keys declarations)) mode) mode (throw (ex-info "Unsupported mode option" {:key :mode :value mode})))
          :depth depth}]
       (cond (sequential? x)
             (let [[parent attributes & children] x
                   [parent attributes children]
                   (if (map? attributes)
                     [parent attributes children]
                     (let [[parent & children] x] [parent {} children]))
                   [parent attributes]
                   (parse-element mode parent attributes)]
               (yoke (if (= depth 0) declaration) \< parent (if-not (empty? attributes) \space)
                     (str/join \space (map (fn [[k v]] (str k \= \" (str/escape v escape-characters) \")) attributes))
                     (if (or (and (= mode :html) (contains? void-elements parent))
                             (and (= mode :xml) (empty? children))) "/>"
                         [\> (map (partial write-string (update options :depth inc)) children) "</" parent \>])))
             (string? x) (str/escape x escape-characters)
             (some? x) (throw (ex-info "Unsupported data type" {:options options :type (type x) :value x}))))))
	(ns anthology.xhtml
	"XML/HTML emitter"
	(:require [clojure.string :as str]))

	(defn- yoke [& xs] (apply str (flatten xs)))

	(def escape-characters
	{\" """
	\' "'"
	\& "&"
	\< "<"
	\> ">"})

	(defn- parse-element
	[mode element attributes]
	(let [element (name element) selectors {"." "class" "#" "id"}]
	(if (= mode :xml)
	[element attributes]
	[(re-find #"[^\.#]+" element)
	(reduce (fn [m [_ k v]] (let [attr (selectors k)] (update m attr str (if (contains? m attr) \space) v)))
	(into {} (map (fn [[k v]] [(name k) v]) attributes))
	(re-seq #"([#\.])(\w+)" element))])))

	(def void-elements
	"Set of void elements, as defined in HTML5 spec"
	#{"area" "base" "br" "col" "embed" "hr" "img" "input"
	"keygen" "link" "meta" "param" "source" "track" "wbr"})

	(def declarations
	{:html "<!doctype html>" :xml "<?xml version=\"1.0\" ?>"})

	(defn write-string
	"Emit HTML/XML document with the supplied contents. Supported options:
	:declaration - XML/HTML declaration (doctype), default depends on :mode
	:mode - Emit mode, can be either :html or :xml"
	([x] (write-string {} x))
	([{:keys [declaration mode depth] :or {mode :html depth 0} :as options} x]
	(let [{:keys [declaration] :as options}
	{:declaration (if (some #{:declaration} (keys options)) declaration (declarations mode))
	:mode (if (contains? (set (keys declarations)) mode) mode (throw (ex-info "Unsupported mode option" {:key :mode :value mode})))
	:depth depth}]
	(cond (sequential? x)
	(let [[parent attributes & children] x
	[parent attributes children]
	(if (map? attributes)
	[parent attributes children]
	(let [[parent & children] x] [parent {} children]))
	[parent attributes]
	(parse-element mode parent attributes)]
	(yoke (if (= depth 0) declaration) \< parent (if-not (empty? attributes) \space)
	(str/join \space (map (fn [[k v]] (str k \= \" (str/escape v escape-characters) \")) attributes))
	(if (or (and (= mode :html) (contains? void-elements parent))
	(and (= mode :xml) (empty? children))) "/>"
	[\> (map (partial write-string (update options :depth inc)) children) "</" parent \>])))
	(string? x) (str/escape x escape-characters)
	(some? x) (throw (ex-info "Unsupported data type" {:options options :type (type x) :value x}))))))