luciano/babashka
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[#646] Add hiccup.core and hiccup2.core

Browse source
This commit is contained in:
Michiel Borkent 2021-01-23 22:47:35 +01:00 committed by GitHub
parent 6dc6cbab12
commit c4bb42df3e
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
12 changed files with 471 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
deps.edn
View file

@ -4,6 +4,7 @@
"feature-httpkit-client" "feature-httpkit-server"
"feature-lanterna"
"feature-core-match"
"feature-hiccup"
"sci/src" "babashka.curl/src" "pods/src"
"babashka.nrepl/src"
"depstar/src" "process/src"
@ -28,7 +29,8 @@
http-kit/http-kit {:mvn/version "2.5.0"}
babashka/clojure-lanterna {:mvn/version "0.9.8-SNAPSHOT"}
org.clojure/math.combinatorics {:mvn/version "0.1.6"}
org.clojure/core.match {:mvn/version "1.0.0"}}
org.clojure/core.match {:mvn/version "1.0.0"}
hiccup/hiccup {:mvn/version "2.0.0-alpha2"}}
:aliases {:main
{:main-opts ["-m" "babashka.main"]}
:profile

1
doc/build.md
View file

@ -98,6 +98,7 @@ Babashka supports the following feature flags:
| `BABASHKA_FEATURE_HTTPKIT_CLIENT` | Includes the [http-kit](https://github.com/http-kit/http-kit) client library | `true` |
| `BABASHKA_FEATURE_HTTPKIT_SERVER` | Includes the [http-kit](https://github.com/http-kit/http-kit) server library | `true` |
| `BABASHKA_FEATURE_CORE_MATCH` | Includes the [clojure.core.match](https://github.com/clojure/core.match) library | `true` |
| `BABASHKA_FEATURE_HICCUP` | Includes the [hiccup](https://github.com/weavejester/hiccup) library | `true` |
| `BABASHKA_FEATURE_JDBC` | Includes the [next.jdbc](https://github.com/seancorfield/next-jdbc) library | `false` |
| `BABASHKA_FEATURE_POSTGRESQL` | Includes the [PostgresSQL](https://jdbc.postgresql.org/) JDBC driver | `false` |
| `BABASHKA_FEATURE_HSQLDB` | Includes the [HSQLDB](http://www.hsqldb.org/) JDBC driver | `false` |

74
feature-hiccup/babashka/impl/hiccup.clj Normal file
View file

@ -0,0 +1,74 @@
(ns babashka.impl.hiccup
{:no-doc true}
(:require [hiccup.compiler :as compiler]
[hiccup.util :as util]
[sci.core :as sci :refer [copy-var]]))
(def hns (sci/create-ns 'hiccup.core nil))
(def hns2 (sci/create-ns 'hiccup2.core nil))
(def uns (sci/create-ns 'hiccup.util nil))
(def cns (sci/create-ns 'hiccup.compiler nil))
(defmacro html-2
"Render Clojure data structures to a compiled representation of HTML. To turn
the representation into a string, use clojure.core/str. Strings inside the
macro are automatically HTML-escaped. To insert a string without it being
escaped, use the [[raw]] function.
A literal option map may be specified as the first argument. It accepts two
keys that control how the HTML is outputted:
`:mode`
: One of `:html`, `:xhtml`, `:xml` or `:sgml` (defaults to `:xhtml`).
Controls how tags are rendered.
`:escape-strings?`
: True if strings should be escaped (defaults to true)."
{:added "2.0"}
[options & content]
;; (prn :escape-strings util/*escape-strings?*)
(if (map? options)
(let [mode (:mode options :xhtml)
escape-strings? (:escape-strings? options true)]
`(binding
[util/*html-mode* ~mode
util/*escape-strings?* ~escape-strings?]
(util/raw-string (compiler/render-html (list ~@content)))))
`(util/raw-string (compiler/render-html (list ~@(cons options content))))))
(defmacro html-1
"Render Clojure data structures to a string of HTML. Strings are **not**
automatically escaped, but must be manually escaped with the [[h]] function.
A literal option map may be specified as the first argument. It accepts the
following keys:
`:mode`
: One of `:html`, `:xhtml`, `:xml` or `:sgml` (defaults to `:xhtml`).
Controls how tags are rendered."
;; {:deprecated "2.0"}
[options & content]
(if (map? options)
`(str (hiccup2.core/html ~(assoc options :escape-strings? false) ~@content))
`(str (hiccup2.core/html {:escape-strings? false} ~options ~@content))))
(def ^{:added "2.0"} raw
"Short alias for [[hiccup.util/raw-string]]."
util/raw-string)
(def hiccup-namespace
{'html (copy-var html-1 hns)})
(def hiccup2-namespace
{'html (copy-var html-2 hns2)})
(def html-mode (copy-var util/*html-mode* uns))
(def escape-strings? (copy-var util/*escape-strings?* uns))
(def hiccup-util-namespace
{'*html-mode* html-mode
'*escape-strings?* escape-strings?
'raw-string (copy-var util/raw-string uns)})
(defn render-html [& contents]
(binding [util/*html-mode* @html-mode
util/*escape-strings?* @escape-strings?]
(apply compiler/render-html contents)))
(def hiccup-compiler-namespace
{'render-html (copy-var render-html cns)})

4
project.clj
View file

@ -48,7 +48,8 @@
:dependencies [[babashka/clojure-lanterna "0.9.8-SNAPSHOT"]]}
:feature/core-match {:source-paths ["feature-core-match"]
:dependencies [[org.clojure/core.match "1.0.0"]]}
:feature/hiccup {:source-paths ["feature-hiccup"]
:dependencies [[hiccup/hiccup "2.0.0-alpha2"]]}
:test [:feature/xml
:feature/lanterna
:feature/yaml
@ -61,6 +62,7 @@
:feature/httpkit-client
:feature/httpkit-server
:feature/core-match
:feature/hiccup
{:dependencies [[clj-commons/conch "0.9.2"]
[com.clojure-goes-fast/clj-async-profiler "0.4.1"]
[com.opentable.components/otj-pg-embedded "0.13.3"]]}]

1
script/compile
View file

@ -95,6 +95,7 @@ then
export BABASHKA_FEATURE_HTTPKIT_CLIENT="${BABASHKA_FEATURE_HTTPKIT_CLIENT:-false}"
export BABASHKA_FEATURE_HTTPKIT_SERVER="${BABASHKA_FEATURE_HTTPKIT_SERVER:-false}"
export BABASHKA_FEATURE_CORE_MATCH="${BABASHKA_FEATURE_CORE_MATCH:-false}"
export BABASHKA_FEATURE_HICCUP="${BABASHKA_FEATURE_HICCUP:-false}"
fi
"$GRAALVM_HOME/bin/native-image" "${args[@]}"

7
script/uberjar
View file

@ -125,6 +125,13 @@ else
BABASHKA_LEIN_PROFILES+=",-feature/core-match"
fi
if [ "$BABASHKA_FEATURE_HICCUP" != "false" ]
then
BABASHKA_LEIN_PROFILES+=",+feature/hiccup"
else
BABASHKA_LEIN_PROFILES+=",-feature/hiccup"
fi
if [ -z "$BABASHKA_JAR" ]; then
lein with-profiles "$BABASHKA_LEIN_PROFILES,+reflection,-uberjar" do run
lein with-profiles "$BABASHKA_LEIN_PROFILES" do clean, uberjar

6
script/uberjar.bat
View file

@ -94,6 +94,12 @@ set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,+feature/core-match
set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,-feature/core-match
)
if not "%BABASHKA_FEATURE_HICCUP%"=="false" (
set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,+feature/hiccup
) else (
set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,-feature/hiccup
)
call lein with-profiles %BABASHKA_LEIN_PROFILES% bb "(+ 1 2 3)"
call lein with-profiles %BABASHKA_LEIN_PROFILES%,+reflection,-uberjar do run

1
src/babashka/impl/features.clj
View file

@ -12,6 +12,7 @@
(def httpkit-client? (not= "false" (System/getenv "BABASHKA_FEATURE_HTTPKIT_CLIENT")))
(def httpkit-server? (not= "false" (System/getenv "BABASHKA_FEATURE_HTTPKIT_SERVER")))
(def core-match? (not= "false" (System/getenv "BABASHKA_FEATURE_CORE_MATCH")))
(def hiccup? (not= "false" (System/getenv "BABASHKA_FEATURE_HICCUP")))
;; excluded by default
(def jdbc? (= "true" (System/getenv "BABASHKA_FEATURE_JDBC")))

15
src/babashka/main.clj
View file

@ -97,6 +97,9 @@
(when features/core-match?
(require '[babashka.impl.match]))
(when features/hiccup?
(require '[babashka.impl.hiccup]))
(sci/alter-var-root sci/in (constantly *in*))
(sci/alter-var-root sci/out (constantly *out*))
(sci/alter-var-root sci/err (constantly *err*))
@ -303,7 +306,8 @@ Use -- to separate script command line args from bb command line args.
:feature/oracledb %s
:feature/httpkit-client %s
:feature/lanterna %s
:feature/core-match %s}")
:feature/core-match %s
:feature/hiccup %s}")
version
features/core-async?
features/csv?
@ -317,7 +321,8 @@ Use -- to separate script command line args from bb command line args.
features/oracledb?
features/httpkit-client?
features/lanterna?
features/core-match?)))
features/core-match?
features/hiccup?)))
(defn read-file [file]
(let [f (io/file file)]
@ -427,7 +432,11 @@ Use -- to separate script command line args from bb command line args.
features/lanterna? (assoc 'lanterna.screen @(resolve 'babashka.impl.lanterna/lanterna-screen-namespace)
'lanterna.terminal @(resolve 'babashka.impl.lanterna/lanterna-terminal-namespace)
'lanterna.constants @(resolve 'babashka.impl.lanterna/lanterna-constants-namespace))
features/core-match? (assoc 'clojure.core.match @(resolve 'babashka.impl.match/core-match-namespace))))
features/core-match? (assoc 'clojure.core.match @(resolve 'babashka.impl.match/core-match-namespace))
features/hiccup? (-> (assoc 'hiccup.core @(resolve 'babashka.impl.hiccup/hiccup-namespace))
(assoc 'hiccup2.core @(resolve 'babashka.impl.hiccup/hiccup2-namespace))
(assoc 'hiccup.util @(resolve 'babashka.impl.hiccup/hiccup-util-namespace))
(assoc 'hiccup.compiler @(resolve 'babashka.impl.hiccup/hiccup-compiler-namespace)))))
(def imports
'{ArithmeticException java.lang.ArithmeticException

3
test-resources/lib_tests/babashka/run_all_libtests.clj
View file

@ -171,6 +171,9 @@
(test-namespaces 'core-match.core-tests)
(test-namespaces 'hiccup.core-test)
(test-namespaces 'hiccup2.core-test)
;;;; final exit code
(let [{:keys [:test :fail :error] :as m} @status]

145
test-resources/lib_tests/hiccup/core_test.clj Normal file
View file

@ -0,0 +1,145 @@
(ns hiccup.core-test
(:require [clojure.test :refer :all]
[hiccup.core :refer :all]))
(deftest tag-names
(testing "basic tags"
(is (= (html [:div]) "<div></div>"))
(is (= (html ["div"]) "<div></div>"))
(is (= (html ['div]) "<div></div>")))
(testing "tag syntax sugar"
(is (= (html [:div#foo]) "<div id=\"foo\"></div>"))
(is (= (html [:div.foo]) "<div class=\"foo\"></div>"))
(is (= (html [:div.foo (str "bar" "baz")])
"<div class=\"foo\">barbaz</div>"))
(is (= (html [:div.a.b]) "<div class=\"a b\"></div>"))
(is (= (html [:div.a.b.c]) "<div class=\"a b c\"></div>"))
(is (= (html [:div#foo.bar.baz])
"<div class=\"bar baz\" id=\"foo\"></div>"))))
(deftest tag-contents
(testing "empty tags"
(is (= (html [:div]) "<div></div>"))
(is (= (html [:h1]) "<h1></h1>"))
(is (= (html [:script]) "<script></script>"))
(is (= (html [:text]) "<text></text>"))
(is (= (html [:a]) "<a></a>"))
(is (= (html [:iframe]) "<iframe></iframe>"))
(is (= (html [:title]) "<title></title>"))
(is (= (html [:section]) "<section></section>"))
(is (= (html [:select]) "<select></select>"))
(is (= (html [:object]) "<object></object>"))
(is (= (html [:video]) "<video></video>")))
(testing "void tags"
(is (= (html [:br]) "<br />"))
(is (= (html [:link]) "<link />"))
(is (= (html [:colgroup {:span 2}] "<colgroup span=\"2\" />")))
(is (= (html [:colgroup [:col]] "<colgroup><col /></colgroup>"))))
(testing "tags containing text"
(is (= (html [:text "Lorem Ipsum"]) "<text>Lorem Ipsum</text>")))
(testing "contents are concatenated"
(is (= (html [:body "foo" "bar"]) "<body>foobar</body>"))
(is (= (html [:body [:p] [:br]]) "<body><p></p><br /></body>")))
(testing "seqs are expanded"
(is (= (html [:body (list "foo" "bar")]) "<body>foobar</body>"))
(is (= (html (list [:p "a"] [:p "b"])) "<p>a</p><p>b</p>")))
(testing "keywords are turned into strings"
(is (= (html [:div :foo]) "<div>foo</div>")))
(testing "vecs don't expand - error if vec doesn't have tag name"
(is (thrown? IllegalArgumentException
(html (vector [:p "a"] [:p "b"])))))
(testing "tags can contain tags"
(is (= (html [:div [:p]]) "<div><p></p></div>"))
(is (= (html [:div [:b]]) "<div><b></b></div>"))
(is (= (html [:p [:span [:a "foo"]]])
"<p><span><a>foo</a></span></p>"))))
(deftest tag-attributes
(testing "tag with blank attribute map"
(is (= (html [:xml {}]) "<xml></xml>")))
(testing "tag with populated attribute map"
(is (= (html [:xml {:a "1", :b "2"}]) "<xml a=\"1\" b=\"2\"></xml>"))
(is (= (html [:img {"id" "foo"}]) "<img id=\"foo\" />"))
(is (= (html [:img {'id "foo"}]) "<img id=\"foo\" />"))
(is (= (html [:xml {:a "1", 'b "2", "c" "3"}])
"<xml a=\"1\" b=\"2\" c=\"3\"></xml>")))
(testing "attribute values are escaped"
(is (= (html [:div {:id "\""}]) "<div id=\"&quot;\"></div>")))
(testing "boolean attributes"
(is (= (html [:input {:type "checkbox" :checked true}])
"<input checked=\"checked\" type=\"checkbox\" />"))
(is (= (html [:input {:type "checkbox" :checked false}])
"<input type=\"checkbox\" />")))
(testing "nil attributes"
(is (= (html [:span {:class nil} "foo"])
"<span>foo</span>")))
(testing "resolving conflicts between attributes in the map and tag"
(is (= (html [:div.foo {:class "bar"} "baz"])
"<div class=\"foo bar\">baz</div>"))
(is (= (html [:div#bar.foo {:id "baq"} "baz"])
"<div class=\"foo\" id=\"baq\">baz</div>")))
;; Not released yet
#_(testing "tag with vector class"
(is (= (html [:div.foo {:class ["bar"]} "baz"])
"<div class=\"foo bar\">baz</div>"))
(is (= (html [:div.foo {:class [:bar]} "baz"])
"<div class=\"foo bar\">baz</div>"))
(is (= (html [:div.foo {:class [:bar "box"]} "baz"])
"<div class=\"foo bar box\">baz</div>"))
(is (= (html [:div.foo {:class ["bar" "box"]} "baz"])
"<div class=\"foo bar box\">baz</div>"))
(is (= (html [:div.foo {:class [:bar :box]} "baz"])
"<div class=\"foo bar box\">baz</div>"))))
(deftest compiled-tags
(testing "tag content can be vars"
(is (= (let [x "foo"] (html [:span x])) "<span>foo</span>")))
(testing "tag content can be forms"
(is (= (html [:span (str (+ 1 1))]) "<span>2</span>"))
(is (= (html [:span ({:foo "bar"} :foo)]) "<span>bar</span>")))
(testing "attributes can contain vars"
(let [x "foo"]
(is (= (html [:xml {:x x}]) "<xml x=\"foo\"></xml>"))
(is (= (html [:xml {x "x"}]) "<xml foo=\"x\"></xml>"))
(is (= (html [:xml {:x x} "bar"]) "<xml x=\"foo\">bar</xml>"))))
(testing "attributes are evaluated"
(is (= (html [:img {:src (str "/foo" "/bar")}])
"<img src=\"/foo/bar\" />"))
(is (= (html [:div {:id (str "a" "b")} (str "foo")])
"<div id=\"ab\">foo</div>")))
(testing "type hints"
(let [string "x"]
(is (= (html [:span ^String string]) "<span>x</span>"))))
(testing "optimized forms"
(is (= (html [:ul (for [n (range 3)]
[:li n])])
"<ul><li>0</li><li>1</li><li>2</li></ul>"))
(is (= (html [:div (if true
[:span "foo"]
[:span "bar"])])
"<div><span>foo</span></div>")))
(testing "values are evaluated only once"
(let [times-called (atom 0)
foo #(swap! times-called inc)]
(html [:div (foo)])
(is (= @times-called 1))))
(testing "defer evaluation of non-literal class names when combined with tag classes"
(let [x "attr-class"]
(is (= (html [:div.tag-class {:class x}])
"<div class=\"tag-class attr-class\"></div>")))))
(deftest render-modes
(testing "closed tag"
(is (= (html [:p] [:br]) "<p></p><br />"))
(is (= (html {:mode :xhtml} [:p] [:br]) "<p></p><br />"))
(is (= (html {:mode :html} [:p] [:br]) "<p></p><br>"))
(is (= (html {:mode :xml} [:p] [:br]) "<p /><br />"))
(is (= (html {:mode :sgml} [:p] [:br]) "<p><br>")))
(testing "boolean attributes"
(is (= (html {:mode :xml} [:input {:type "checkbox" :checked true}])
"<input checked=\"checked\" type=\"checkbox\" />"))
(is (= (html {:mode :sgml} [:input {:type "checkbox" :checked true}])
"<input checked type=\"checkbox\">")))
(testing "laziness and binding scope"
(is (= (html {:mode :sgml} [:html [:link] (list [:link])])
"<html><link><link></html>"))))

213
test-resources/lib_tests/hiccup2/core_test.clj Normal file
View file

@ -0,0 +1,213 @@
(ns hiccup2.core-test
(:require [clojure.test :refer :all]
[hiccup2.core :refer :all]
[hiccup.util :as util]))
(deftest return-types
#_(testing "html returns a RawString"
(is (util/raw-string? (html [:div]))))
(testing "converting to string"
(= (str (html [:div])) "<div></div>")))
(deftest tag-names
(testing "basic tags"
(is (= (str (html [:div])) "<div></div>"))
(is (= (str (html ["div"])) "<div></div>"))
(is (= (str (html ['div])) "<div></div>")))
(testing "tag syntax sugar"
(is (= (str (html [:div#foo])) "<div id=\"foo\"></div>"))
(is (= (str (html [:div.foo])) "<div class=\"foo\"></div>"))
(is (= (str (html [:div.foo (str "bar" "baz")]))
"<div class=\"foo\">barbaz</div>"))
(is (= (str (html [:div.a.b])) "<div class=\"a b\"></div>"))
(is (= (str (html [:div.a.b.c])) "<div class=\"a b c\"></div>"))
(is (= (str (html [:div#foo.bar.baz]))
"<div class=\"bar baz\" id=\"foo\"></div>"))))
(deftest tag-contents
(testing "empty tags"
(is (= (str (html [:div])) "<div></div>"))
(is (= (str (html [:h1])) "<h1></h1>"))
(is (= (str (html [:script])) "<script></script>"))
(is (= (str (html [:text])) "<text></text>"))
(is (= (str (html [:a])) "<a></a>"))
(is (= (str (html [:iframe])) "<iframe></iframe>"))
(is (= (str (html [:title])) "<title></title>"))
(is (= (str (html [:section])) "<section></section>"))
(is (= (str (html [:select])) "<select></select>"))
(is (= (str (html [:object])) "<object></object>"))
(is (= (str (html [:video])) "<video></video>")))
(testing "void tags"
(is (= (str (html [:br])) "<br />"))
(is (= (str (html [:link])) "<link />"))
(is (= (str (html [:colgroup {:span 2}])) "<colgroup span=\"2\"></colgroup>"))
(is (= (str (html [:colgroup [:col]])) "<colgroup><col /></colgroup>")))
(testing "tags containing text"
(is (= (str (html [:text "Lorem Ipsum"])) "<text>Lorem Ipsum</text>")))
(testing "contents are concatenated"
(is (= (str (html [:body "foo" "bar"])) "<body>foobar</body>"))
(is (= (str (html [:body [:p] [:br]])) "<body><p></p><br /></body>")))
(testing "seqs are expanded"
(is (= (str (html [:body (list "foo" "bar")])) "<body>foobar</body>"))
(is (= (str (html (list [:p "a"] [:p "b"]))) "<p>a</p><p>b</p>")))
(testing "keywords are turned into strings"
(is (= (str (html [:div :foo])) "<div>foo</div>")))
(testing "vecs don't expand - error if vec doesn't have tag name"
(is (thrown? IllegalArgumentException
(html (vector [:p "a"] [:p "b"])))))
(testing "tags can contain tags"
(is (= (str (html [:div [:p]])) "<div><p></p></div>"))
(is (= (str (html [:div [:b]])) "<div><b></b></div>"))
(is (= (str (html [:p [:span [:a "foo"]]]))
"<p><span><a>foo</a></span></p>"))))
(deftest tag-attributes
(testing "tag with blank attribute map"
(is (= (str (html [:xml {}])) "<xml></xml>")))
(testing "tag with populated attribute map"
(is (= (str (html [:xml {:a "1", :b "2"}])) "<xml a=\"1\" b=\"2\"></xml>"))
(is (= (str (html [:img {"id" "foo"}])) "<img id=\"foo\" />"))
(is (= (str (html [:img {'id "foo"}])) "<img id=\"foo\" />"))
(is (= (str (html [:xml {:a "1", 'b "2", "c" "3"}]))
"<xml a=\"1\" b=\"2\" c=\"3\"></xml>")))
(testing "attribute values are escaped"
(is (= (str (html [:div {:id "\""}])) "<div id=\"&quot;\"></div>")))
(testing "boolean attributes"
(is (= (str (html [:input {:type "checkbox" :checked true}]))
"<input checked=\"checked\" type=\"checkbox\" />"))
(is (= (str (html [:input {:type "checkbox" :checked false}]))
"<input type=\"checkbox\" />")))
(testing "nil attributes"
(is (= (str (html [:span {:class nil} "foo"]))
"<span>foo</span>")))
(testing "vector attributes"
(is (= (str (html [:span {:class ["bar" "baz"]} "foo"]))
"<span class=\"bar baz\">foo</span>"))
(is (= (str (html [:span {:class ["baz"]} "foo"]))
"<span class=\"baz\">foo</span>"))
(is (= (str (html [:span {:class "baz bar"} "foo"]))
"<span class=\"baz bar\">foo</span>")))
(testing "map attributes"
(is (= (str (html [:span {:style {:color "red" :opacity "100%"}} "foo"]))
"<span style=\"color:red;opacity:100%;\">foo</span>")))
(testing "resolving conflicts between attributes in the map and tag"
(is (= (str (html [:div.foo {:class "bar"} "baz"]))
"<div class=\"foo bar\">baz</div>"))
(is (= (str (html [:div.foo {:class ["bar"]} "baz"]))
"<div class=\"foo bar\">baz</div>"))
(is (= (str (html [:div#bar.foo {:id "baq"} "baz"]))
"<div class=\"foo\" id=\"baq\">baz</div>"))))
(deftest compiled-tags
(testing "tag content can be vars"
(is (= (let [x "foo"] (str (html [:span x]))) "<span>foo</span>")))
(testing "tag content can be forms"
(is (= (str (html [:span (str (+ 1 1))])) "<span>2</span>"))
(is (= (str (html [:span ({:foo "bar"} :foo)])) "<span>bar</span>")))
(testing "attributes can contain vars"
(let [x "foo"]
(is (= (str (html [:xml {:x x}])) "<xml x=\"foo\"></xml>"))
(is (= (str (html [:xml {x "x"}])) "<xml foo=\"x\"></xml>"))
(is (= (str (html [:xml {:x x} "bar"])) "<xml x=\"foo\">bar</xml>"))))
(testing "attributes are evaluated"
(is (= (str (html [:img {:src (str "/foo" "/bar")}]))
"<img src=\"/foo/bar\" />"))
(is (= (str (html [:div {:id (str "a" "b")} (str "foo")]))
"<div id=\"ab\">foo</div>")))
(testing "type hints"
(let [string "x"]
(is (= (str (html [:span ^String string])) "<span>x</span>"))))
(testing "optimized forms"
(is (= (str (html [:ul (for [n (range 3)]
[:li n])]))
"<ul><li>0</li><li>1</li><li>2</li></ul>"))
(is (= (str (html [:div (if true
[:span "foo"]
[:span "bar"])]))
"<div><span>foo</span></div>")))
(testing "values are evaluated only once"
(let [times-called (atom 0)
foo #(swap! times-called inc)]
(html [:div (foo)])
(is (= @times-called 1)))))
(deftest render-modes
(testing "closed tag"
(is (= (str (html [:p] [:br])) "<p></p><br />"))
(is (= (str (html {:mode :xhtml} [:p] [:br])) "<p></p><br />"))
(is (= (str (html {:mode :html} [:p] [:br])) "<p></p><br>"))
(is (= (str (html {:mode :xml} [:p] [:br])) "<p /><br />"))
(is (= (str (html {:mode :sgml} [:p] [:br])) "<p><br>")))
(testing "boolean attributes"
(is (= (str (html {:mode :xml} [:input {:type "checkbox" :checked true}]))
"<input checked=\"checked\" type=\"checkbox\" />"))
(is (= (str (html {:mode :sgml} [:input {:type "checkbox" :checked true}]))
"<input checked type=\"checkbox\">")))
(testing "laziness and binding scope"
(is (= (str (html {:mode :sgml} [:html [:link] (list [:link])]))
"<html><link><link></html>")))
(testing "function binding scope"
(let [f #(html [:p "<>" [:br]])]
(is (= (str (html (f))) "<p>&lt;&gt;<br /></p>"))
(is (= (str (html {:escape-strings? false} (f))) "<p><><br /></p>"))
(is (= (str (html {:mode :html} (f))) "<p>&lt;&gt;<br></p>"))
(is (= (str (html {:escape-strings? false, :mode :html} (f))) "<p><><br></p>")))))
(deftest auto-escaping
(testing "literals"
(is (= (str (html "<>")) "&lt;&gt;"))
(is (= (str (html :<>)) "&lt;&gt;"))
(is (= (str (html ^String (str "<>"))) "&lt;&gt;"))
(is (= (str (html {} {"<a>" "<b>"})) "{&quot;&lt;a&gt;&quot; &quot;&lt;b&gt;&quot;}"))
(is (= (str (html #{"<>"})) "#{&quot;&lt;&gt;&quot;}"))
(is (= (str (html 1)) "1"))
(is (= (str (html ^Number (+ 1 1))) "2")))
(testing "non-literals"
(is (= (str (html (list [:p "<foo>"] [:p "<bar>"])))
"<p>&lt;foo&gt;</p><p>&lt;bar&gt;</p>"))
(is (= (str (html ((constantly "<foo>")))) "&lt;foo&gt;"))
(is (= (let [x "<foo>"] (str (html x))) "&lt;foo&gt;")))
(testing "optimized forms"
(is (= (str (html (if true :<foo> :<bar>))) "&lt;foo&gt;"))
(is (= (str (html (for [x [:<foo>]] x))) "&lt;foo&gt;")))
(testing "elements"
(is (= (str (html [:p "<>"])) "<p>&lt;&gt;</p>"))
(is (= (str (html [:p :<>])) "<p>&lt;&gt;</p>"))
(is (= (str (html [:p {} {"<foo>" "<bar>"}]))
"<p>{&quot;&lt;foo&gt;&quot; &quot;&lt;bar&gt;&quot;}</p>"))
(is (= (str (html [:p {} #{"<foo>"}]))
"<p>#{&quot;&lt;foo&gt;&quot;}</p>"))
(is (= (str (html [:p {:class "<\">"}]))
"<p class=\"&lt;&quot;&gt;\"></p>"))
(is (= (str (html [:p {:class ["<\">"]}]))
"<p class=\"&lt;&quot;&gt;\"></p>"))
(is (= (str (html [:ul [:li "<foo>"]]))
"<ul><li>&lt;foo&gt;</li></ul>")))
(testing "raw strings"
#_(is (= (str (html (util/raw-string "<foo>"))) "<foo>"))
(is (= (str (html [:p (util/raw-string "<foo>")])) "<p><foo></p>"))
(is (= (str (html (html [:p "<>"]))) "<p>&lt;&gt;</p>"))
(is (= (str (html [:ul (html [:li "<>"])])) "<ul><li>&lt;&gt;</li></ul>"))))
(deftest html-escaping
(testing "precompilation"
(is (= (str (html {:escape-strings? true} [:p "<>"])) "<p>&lt;&gt;</p>"))
(is (= (str (html {:escape-strings? false} [:p "<>"])) "<p><></p>")))
(testing "dynamic generation"
(let [x [:p "<>"]]
(is (= (str (html {:escape-strings? true} x)) "<p>&lt;&gt;</p>"))
(is (= (str (html {:escape-strings? false} x)) "<p><></p>"))))
(testing "attributes"
(is (= (str (html {:escape-strings? true} [:p {:class "<>"}]))
"<p class=\"&lt;&gt;\"></p>"))
(is (= (str (html {:escape-strings? false} [:p {:class "<>"}]))
"<p class=\"&lt;&gt;\"></p>")))
(testing "raw strings"
(is (= (str (html {:escape-strings? true} [:p (util/raw-string "<>")]))
"<p><></p>"))
(is (= (str (html {:escape-strings? false} [:p (util/raw-string "<>")]))
"<p><></p>"))
#_(is (= (str (html {:escape-strings? true} [:p (raw "<>")]))
"<p><></p>"))
#_(is (= (str (html {:escape-strings? false} [:p (raw "<>")]))
"<p><></p>"))))