Converts Bootstrap HTML to ClojureScript Om Code

parsehtml.clj

(ns com.seltzer1717.term.server.parsehtml
  (:import
    (java.io FileReader FileWriter BufferedReader BufferedWriter)
    (javax.swing.text.html HTMLEditorKit HTMLEditorKit$ParserCallback HTML$Tag HTML$UnknownTag HTML$Attribute)
    (javax.swing.text.html.parser ParserDelegator)))

(def new-elements
  #{"section" "article" "main" "aside" "header" "footer" "nav" "figure"
    "figcaption" "template" "video" "audio " "track" "source" "embed"
    "mark" "progress" "meter" "time" "ruby" "rt" "rp" "bdi" "wbr" "canvas"
    "datalist" "keygen" "output" "abbr" "acronym" "bdo" "button" "col"
    "colgroup" "del" "fieldset" "frame" "frameset" "iframe" "ins" "label"
    "legend" "noframes" "noscript" "object" "optgroup" "q" "s" "span"
    "tbody" "tfoot" "thead"})

(def attribute-conversion
  {"class"            "className"
   "tabindex"         "tabIndex"
   "accesskey"        "accessKey"
   "spellcheck"       "spellCheck"
   "contenteditable"  "contentEditable"
   "hreflang"         "hrefLang"
   "crossorgin"       "crossOrigin"
   "autoplan"         "autoPlay"
   "mediagroup"       "mediaGroup"
   "onafterprint"     "onAfterPrint"
   "onbeforeprint"    "onBeforePrint"
   "onbeforeunload"   "onBeforeUnload"
   "onhashchange"     "onHashChange"
   "onmessage"        "onMessage"
   "onoffline"        "onOffline"
   "ononline"         "onOnline"
   "onpagehide"       "onPageHide"
   "onpageshow"       "onPageShow"
   "onpopstate"       "onPopState"
   "onstorage"        "onStorage"
   "onunload"         "onUnload"
   "formaction"       "formAction"
   "formenctype"      "formEnctype"
   "formmethod"       "formMethod"
   "formnovalidate"   "formNoValidate"
   "formtarget"       "formTarget"
   "autocomplete"     "autoComplete"
   "novalidate"       "noValidate"
   "onabort"          "onAbort"
   "onblur"           "onBlur"
   "oncancel"         "onCancel"
   "oncanplay"        "onCanPlay"
   "oncanplaythrough" "onCanPlayThrough"
   "onchange"         "onChange"
   "onclick"          "onClick"
   "oncuechange"      "onCueChange"
   "ondblclick"       "onDblClick"
   "ondurationchange" "onDurationChange"
   "onemptied"        "onEmptied"
   "onended"          "onEnded"
   "onerror"          "onError"
   "onfocus"          "onFocus"
   "oninput"          "onInput"
   "oninvalid"        "onInvalid"
   "onkeydown"        "onKeyDown"
   "onkeypress"       "onKeyPress"
   "onkeyup"          "onKeyUp"
   "onload"           "onLoad"
   "onloadeddata"     "onLoadedData"
   "onloadedmetadata" "onLoadedMetadata"
   "onloadstart"      "onLoadStart"
   "onmousedown"      "onMouseDown"
   "onmouseenter"     "onMouseEnter"
   "onmouseleave"     "onMouseLeave"
   "onmousemove"      "onMouseMove"
   "onmouseout"       "onMouseOut"
   "onmouseover"      "onMouseOver"
   "onmouseup"        "onMouseUp"
   "onmousewheel"     "onMouseWhell"
   "onpause"          "onPause"
   "onplay"           "onPlay"
   "onplaying"        "onPlaying"
   "onprogress"       "onProgress"
   "onratechange"     "onRateChange"
   "onreset"          "onReset"
   "onresize"         "onResize"
   "onscroll"         "onScroll"
   "onseeked"         "onSeeked"
   "onseeking"        "onSeeking"
   "onselect"         "onSelect"
   "onshow"           "onShow"
   "onstalled"        "onStalled"
   "onsubmit"         "onSubmit"
   "onsuspend"        "onSuspend"
   "ontimeupdate"     "onTimeUpdate"
   "ontoggle"         "onToggle"
   "onvolumechange"   "onVolumeChange"
   "onwaiting"        "onWaiting"})

(defn- prepare-environment [in out]
  {:buff-reader (BufferedReader. (FileReader. in)) 
   :buff-writer (BufferedWriter. (FileWriter. out))
   :indent-size (atom 0)
   :indentation (char-array "                                ")
   :tag-text    (atom "")})

(defn- handleComment-impl [{:keys [buff-writer indent-size indentation]} chars pos]
  (if (not (.isEmpty (.trim (String. chars))))
      (do (.newLine buff-writer)
          (.write buff-writer indentation 0 @indent-size)
          (.write buff-writer ";; ")
          (.write buff-writer (.trim (String. chars))))))

(defn- handleEndTag-impl [{:keys [buff-writer tag-text indent-size indentation] :as environment} tag pos]
  (if (not (.isEmpty (.trim @tag-text)))
      (do (.newLine buff-writer)
          (.write buff-writer indentation 0 @indent-size)
          (.write buff-writer (str "\"" (.trim @tag-text) "\""))))
  (swap! tag-text (constantly ""))
  (.write buff-writer ")")
  (swap! indent-size - 2))

(defn- start-tag [{:keys [buff-writer indent-size indentation]} tag]
  (if (not= "HTML" (.toUpperCase (.toString tag)))
            (do (.newLine buff-writer)
                (.write buff-writer indentation 0 @indent-size)))
  (->> tag
       (.toString)
       (.toLowerCase)
       (str "(dom/")
       (.write buff-writer))
  (swap! indent-size + 2))

(defn- attribute-iteration [{:keys [buff-writer indent-size indentation]} att-names atts size]
  (while (.hasMoreElements att-names)
         (let [att       (.nextElement att-names)
               att-name  (.toString att) 
               name-adj  (get attribute-conversion att-name att-name)
               att-value (.getAttribute atts att-name)]
           (.write buff-writer (str ":" name-adj " " "\"" att-value "\""))
           (swap! size dec)
           (if (pos? @size)
               (do (.newLine buff-writer)
                   (.write buff-writer indentation 0 @indent-size))))))

(defn- handleStartTag-impl [{:keys [buff-writer indent-size indentation] :as environment} tag atts pos]
  (start-tag environment tag)
  (let [att-names (.getAttributeNames atts)
        size      (atom (.getAttributeCount atts))]
    (.newLine buff-writer)
    (.write buff-writer indentation 0 @indent-size)
    (.write buff-writer "#js{")
    (swap! indent-size + 4)
    (attribute-iteration environment att-names atts size)
    (.write buff-writer "}")
    (swap! indent-size - 4)))

(defn- handleSimpleTag-impl [environment tag atts pos]
  (let [tag-name       (.toString tag)
        newtag?        (contains? new-elements (.toString tag-name))
        endtag?        (= "true" (.getAttribute atts HTML$Attribute/ENDTAG))]
    (if newtag?
      (if endtag?
          (handleEndTag-impl environment tag pos)
          (handleStartTag-impl environment tag atts pos))
      (do (handleStartTag-impl environment tag atts pos)
          (handleEndTag-impl environment tag pos)))))

(defn- handleText-impl [environment chars pos]
  (swap! (:tag-text environment) str (String. chars)))

(defn- close-environment [{:keys [buff-reader buff-writer]}]
  (.flush buff-writer)
  (.close buff-writer)
  (.close buff-reader))

(defn convert [in out]
  (let [environment (prepare-environment in out)
        callback    (proxy [HTMLEditorKit$ParserCallback] []
                      (handleComment   [chars    pos] (handleComment-impl   environment chars    pos))
                      (handleEndTag    [tag      pos] (handleEndTag-impl    environment tag      pos))
                      ;; EditorKit only supports HTML 3.2, newer tags/attributes throw errors, does not block
                      (handleError     [msg      pos])
                      (handleSimpleTag [tag atts pos] (handleSimpleTag-impl environment tag atts pos))
                      (handleStartTag  [tag atts pos] (handleStartTag-impl  environment tag atts pos))
                      (handleText      [chars    pos] (handleText-impl      environment chars    pos)))
        parser      (ParserDelegator.)]
    (.parse parser (:buff-reader environment) callback true)
    (close-environment environment)))