A Babashka script to convert HTML to Hiccup
0
html2hiccup.clj
edited
1#!/usr/bin/env bb
2(ns html2hiccup
3 (:require [babashka.cli :as cli]
4 [camel-snake-kebab.core :as csk]
5 [clojure.java.io :as io]
6 [clojure.string :as str]
7 [zprint.core :as zprint])
8 (:import [org.jsoup Jsoup]
9 [org.jsoup.nodes
10 Attribute
11 Comment
12 DataNode
13 Element
14 Node
15 TextNode]))
16
17(def default-opts
18 {:add-classes-to-tag-keyword true
19 :kebab-attrs false
20 :mapify-style false})
21
22(def special-attr-cases
23 {"baseprofile" "baseProfile"
24 "viewbox" "viewBox"})
25
26(defn normalize-css-value
27 [v]
28 (cond (re-matches #"^-?\d+(\.\d+)?$" v) (Double/parseDouble v)
29 (re-find #"^[a-zA-Z]+$" v) (keyword v)
30 :else (str v)))
31
32(defn mapifier
33 [style-str]
34 (try (into {}
35 (for [[_ k v]
36 (re-seq #"(\S+?)\s*:\s*([^;]+);?" style-str)]
37 [(-> k
38 str/lower-case
39 keyword)
40 (normalize-css-value v)]))
41 (catch Exception _ style-str)))
42
43(defn normalize-attr-key
44 [k kebab-attrs]
45 (let [s (name k)]
46 (keyword (or (special-attr-cases (str/lower-case s))
47 (if kebab-attrs (csk/->kebab-case s) (str/lower-case s))))))
48
49(defn normalize-attrs
50 [attrs {:keys [mapify-style kebab-attrs]}]
51 (let [m (into {}
52 (map (fn [[k v]] [(normalize-attr-key k kebab-attrs) v]))
53 attrs)]
54 (if (and mapify-style (:style m)) (update m :style mapifier) m)))
55
56(defn valid-as-hiccup-kw?
57 [s]
58 (and s (not (re-matches #"^\d.*|.*[./:#@~`\[\]\(\){}].*" s))))
59
60(defn tag+id [tag id] (str tag (when (valid-as-hiccup-kw? id) (str "#" id))))
61
62(defn bisect-all-by
63 [pred coll]
64 (reduce (fn [[yes no] x] (if (pred x) [(conj yes x) no] [yes (conj no x)]))
65 [[] []]
66 coll))
67
68(defn build-tag-with-classes
69 [tag-w-id kw-classes]
70 (str tag-w-id (when (seq kw-classes) (str "." (str/join "." kw-classes)))))
71
72(declare node->hiccup)
73
74(defn text-node->hiccup
75 [^TextNode node]
76 (let [s (some-> node
77 .text
78 str/trim)]
79 (when-not (str/blank? s) s)))
80
81(defn comment-node->hiccup [^Comment node] (list 'comment (.getData node)))
82
83(defn attrs->map
84 [^Element el]
85 (into {}
86 (map (fn [^Attribute a] [(.getKey a) (.getValue a)]))
87 (.attributes el)))
88
89(defn element->hiccup
90 [^Element el options]
91 (let [normalized-attrs (normalize-attrs (attrs->map el) options)
92
93 {:keys [id class]} normalized-attrs
94
95 lower-tag (.tagName el)
96
97 tag-id (tag+id lower-tag id)
98
99 classes (when class (str/split class #"\s+"))
100
101 [kw-classes remaining-classes]
102 (if-not (:add-classes-to-tag-keyword options)
103 [[] classes]
104 (bisect-all-by valid-as-hiccup-kw? classes))
105
106 tag-name (build-tag-with-classes tag-id kw-classes)
107
108 remaining-attrs
109 (cond-> normalized-attrs
110 true (dissoc :class)
111 (seq remaining-classes) (assoc :class (vec remaining-classes))
112 (valid-as-hiccup-kw? id) (dissoc :id))
113
114 children
115 (->> (.childNodes el)
116 (map #(node->hiccup % options))
117 (remove nil?))]
118 (into (cond-> [(keyword tag-name)]
119 (seq remaining-attrs) (conj remaining-attrs))
120 children)))
121
122(defn node->hiccup
123 [^Node node options]
124 (cond (instance? Element node) (element->hiccup node options)
125 (instance? TextNode node) (text-node->hiccup node)
126 (instance? Comment node) (comment-node->hiccup node)
127 (instance? DataNode node) (some-> node
128 .getWholeData
129 str/trim
130 not-empty)
131 :else nil))
132
133(defn html->hiccup
134 ([html] (html->hiccup html default-opts))
135 ([html options]
136 (let [doc (Jsoup/parseBodyFragment html)
137 body (.body doc)]
138 (->> (.childNodes body)
139 (map #(node->hiccup % (merge default-opts options)))
140 (remove nil?)
141 vec))))
142
143(defn pretty-print
144 [form]
145 (zprint/zprint-str form
146 {:map {:comma? false}
147 :style :hiccup}))
148
149(defn convert-html
150 [html options]
151 (->> (html->hiccup html options)
152 (map pretty-print)
153 (str/join "\n")))
154
155(defn output-path
156 [input-file]
157 (let [f (io/file input-file)
158 parent (.getParent f)
159 name (.getName f)
160 stem (str/replace name #"\.[^.]+$" "")
161 out (str stem ".edn")]
162 (if parent (str (io/file parent out)) out)))
163
164(def cli-spec
165 {:add-classes-to-tag-keyword {:coerce :boolean}
166 :kebab-attrs {:coerce :boolean}
167 :mapify-style {:coerce :boolean}})
168
169(defn usage
170 []
171 (println
172 (str/join "\n"
173 ["html2hiccup"
174 ""
175 "Usage:"
176 " html2hiccup [options]"
177 " html2hiccup [options] file1.html file2.htm ..."
178 ""
179 "No files:"
180 " Reads HTML from stdin"
181 " Writes hiccup to stdout"
182 ""
183 "Files:"
184 " Writes sibling .edn files"
185 ""
186 "Options:"
187 " --mapify-style true|false"
188 " --kebab-attrs true|false"
189 " --add-classes-to-tag-keyword true|false"])))
190
191(defn process-file
192 [path options]
193 (let [html (slurp path)
194 out-path (output-path path)
195 result (convert-html html options)]
196 (spit out-path result)
197 (println "Wrote" out-path)))
198
199(defn -main
200 [& argv]
201 (let [{:keys [opts args]}
202 (cli/parse-args argv {:spec cli-spec})]
203 (cond (or (:h opts) (:help opts)) (usage)
204 (seq args) (doseq [path args]
205 (process-file path opts))
206 :else (-> (slurp *in*)
207 (convert-html opts)
208 (println)))))
209
210(apply -main *command-line-args*)