From c4bb42df3e1a8ebcc27fee3a8886137d2f021b6e Mon Sep 17 00:00:00 2001 From: Michiel Borkent Date: Sat, 23 Jan 2021 22:47:35 +0100 Subject: [PATCH] [#646] Add hiccup.core and hiccup2.core --- deps.edn | 4 +- doc/build.md | 5 +- feature-hiccup/babashka/impl/hiccup.clj | 74 ++++++ project.clj | 4 +- script/compile | 1 + script/uberjar | 7 + script/uberjar.bat | 6 + src/babashka/impl/features.clj | 1 + src/babashka/main.clj | 15 +- .../lib_tests/babashka/run_all_libtests.clj | 3 + test-resources/lib_tests/hiccup/core_test.clj | 145 ++++++++++++ .../lib_tests/hiccup2/core_test.clj | 213 ++++++++++++++++++ 12 files changed, 471 insertions(+), 7 deletions(-) create mode 100644 feature-hiccup/babashka/impl/hiccup.clj create mode 100644 test-resources/lib_tests/hiccup/core_test.clj create mode 100644 test-resources/lib_tests/hiccup2/core_test.clj diff --git a/deps.edn b/deps.edn index c3cba45b..bcce61de 100644 --- a/deps.edn +++ b/deps.edn @@ -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 diff --git a/doc/build.md b/doc/build.md index 99880c01..a1f04f28 100644 --- a/doc/build.md +++ b/doc/build.md @@ -70,12 +70,12 @@ docker build --build-arg BABASHKA_FEATURE_JDBC=true --target BASE -t bb-builder container_id=$(docker create bb-builder) docker cp $container_id:/opt/bb bb # copy to ./bb on the host file system docker rm $container_id -``` +``` NOTE: If you get _Error: Image build request failed with exit status 137_ then check whether Docker is allowed to use enough memory (e.g. in Docker Desktop preferences). If it is, then increase the memory GraalVM can use, for example -by adding `--build-arg BABASHKA_XMX="-J-Xmx8g"` +by adding `--build-arg BABASHKA_XMX="-J-Xmx8g"` (or whatever Docker has available, bigger than the default). ## Windows @@ -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` | diff --git a/feature-hiccup/babashka/impl/hiccup.clj b/feature-hiccup/babashka/impl/hiccup.clj new file mode 100644 index 00000000..7263fb88 --- /dev/null +++ b/feature-hiccup/babashka/impl/hiccup.clj @@ -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)}) diff --git a/project.clj b/project.clj index 29b51276..bffcb55a 100644 --- a/project.clj +++ b/project.clj @@ -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"]]}] diff --git a/script/compile b/script/compile index dffa18dd..6a594250 100755 --- a/script/compile +++ b/script/compile @@ -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[@]}" diff --git a/script/uberjar b/script/uberjar index bba50055..afe654e4 100755 --- a/script/uberjar +++ b/script/uberjar @@ -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 diff --git a/script/uberjar.bat b/script/uberjar.bat index 93309395..8abe99d6 100755 --- a/script/uberjar.bat +++ b/script/uberjar.bat @@ -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 diff --git a/src/babashka/impl/features.clj b/src/babashka/impl/features.clj index c2a4e671..dbf6fa62 100644 --- a/src/babashka/impl/features.clj +++ b/src/babashka/impl/features.clj @@ -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"))) diff --git a/src/babashka/main.clj b/src/babashka/main.clj index 186b7c30..a0aa5553 100644 --- a/src/babashka/main.clj +++ b/src/babashka/main.clj @@ -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 diff --git a/test-resources/lib_tests/babashka/run_all_libtests.clj b/test-resources/lib_tests/babashka/run_all_libtests.clj index 1b0964ce..905351a2 100644 --- a/test-resources/lib_tests/babashka/run_all_libtests.clj +++ b/test-resources/lib_tests/babashka/run_all_libtests.clj @@ -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] diff --git a/test-resources/lib_tests/hiccup/core_test.clj b/test-resources/lib_tests/hiccup/core_test.clj new file mode 100644 index 00000000..913fb8f0 --- /dev/null +++ b/test-resources/lib_tests/hiccup/core_test.clj @@ -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]) "
")) + (is (= (html ["div"]) "
")) + (is (= (html ['div]) "
"))) + (testing "tag syntax sugar" + (is (= (html [:div#foo]) "
")) + (is (= (html [:div.foo]) "
")) + (is (= (html [:div.foo (str "bar" "baz")]) + "
barbaz
")) + (is (= (html [:div.a.b]) "
")) + (is (= (html [:div.a.b.c]) "
")) + (is (= (html [:div#foo.bar.baz]) + "
")))) + +(deftest tag-contents + (testing "empty tags" + (is (= (html [:div]) "
")) + (is (= (html [:h1]) "

")) + (is (= (html [:script]) "")) + (is (= (html [:text]) "")) + (is (= (html [:a]) "")) + (is (= (html [:iframe]) "")) + (is (= (html [:title]) "")) + (is (= (html [:section]) "
")) + (is (= (html [:select]) "")) + (is (= (html [:object]) "")) + (is (= (html [:video]) ""))) + (testing "void tags" + (is (= (html [:br]) "
")) + (is (= (html [:link]) "")) + (is (= (html [:colgroup {:span 2}] ""))) + (is (= (html [:colgroup [:col]] "")))) + (testing "tags containing text" + (is (= (html [:text "Lorem Ipsum"]) "Lorem Ipsum"))) + (testing "contents are concatenated" + (is (= (html [:body "foo" "bar"]) "foobar")) + (is (= (html [:body [:p] [:br]]) "


"))) + (testing "seqs are expanded" + (is (= (html [:body (list "foo" "bar")]) "foobar")) + (is (= (html (list [:p "a"] [:p "b"])) "

a

b

"))) + (testing "keywords are turned into strings" + (is (= (html [:div :foo]) "
foo
"))) + (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]]) "

")) + (is (= (html [:div [:b]]) "
")) + (is (= (html [:p [:span [:a "foo"]]]) + "

foo

")))) + +(deftest tag-attributes + (testing "tag with blank attribute map" + (is (= (html [:xml {}]) ""))) + (testing "tag with populated attribute map" + (is (= (html [:xml {:a "1", :b "2"}]) "")) + (is (= (html [:img {"id" "foo"}]) "")) + (is (= (html [:img {'id "foo"}]) "")) + (is (= (html [:xml {:a "1", 'b "2", "c" "3"}]) + ""))) + (testing "attribute values are escaped" + (is (= (html [:div {:id "\""}]) "
"))) + (testing "boolean attributes" + (is (= (html [:input {:type "checkbox" :checked true}]) + "")) + (is (= (html [:input {:type "checkbox" :checked false}]) + ""))) + (testing "nil attributes" + (is (= (html [:span {:class nil} "foo"]) + "foo"))) + (testing "resolving conflicts between attributes in the map and tag" + (is (= (html [:div.foo {:class "bar"} "baz"]) + "
baz
")) + (is (= (html [:div#bar.foo {:id "baq"} "baz"]) + "
baz
"))) + ;; Not released yet + #_(testing "tag with vector class" + (is (= (html [:div.foo {:class ["bar"]} "baz"]) + "
baz
")) + (is (= (html [:div.foo {:class [:bar]} "baz"]) + "
baz
")) + (is (= (html [:div.foo {:class [:bar "box"]} "baz"]) + "
baz
")) + (is (= (html [:div.foo {:class ["bar" "box"]} "baz"]) + "
baz
")) + (is (= (html [:div.foo {:class [:bar :box]} "baz"]) + "
baz
")))) + +(deftest compiled-tags + (testing "tag content can be vars" + (is (= (let [x "foo"] (html [:span x])) "foo"))) + (testing "tag content can be forms" + (is (= (html [:span (str (+ 1 1))]) "2")) + (is (= (html [:span ({:foo "bar"} :foo)]) "bar"))) + (testing "attributes can contain vars" + (let [x "foo"] + (is (= (html [:xml {:x x}]) "")) + (is (= (html [:xml {x "x"}]) "")) + (is (= (html [:xml {:x x} "bar"]) "bar")))) + (testing "attributes are evaluated" + (is (= (html [:img {:src (str "/foo" "/bar")}]) + "")) + (is (= (html [:div {:id (str "a" "b")} (str "foo")]) + "
foo
"))) + (testing "type hints" + (let [string "x"] + (is (= (html [:span ^String string]) "x")))) + (testing "optimized forms" + (is (= (html [:ul (for [n (range 3)] + [:li n])]) + "")) + (is (= (html [:div (if true + [:span "foo"] + [:span "bar"])]) + "
foo
"))) + (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}]) + "
"))))) + +(deftest render-modes + (testing "closed tag" + (is (= (html [:p] [:br]) "


")) + (is (= (html {:mode :xhtml} [:p] [:br]) "


")) + (is (= (html {:mode :html} [:p] [:br]) "


")) + (is (= (html {:mode :xml} [:p] [:br]) "


")) + (is (= (html {:mode :sgml} [:p] [:br]) "


"))) + (testing "boolean attributes" + (is (= (html {:mode :xml} [:input {:type "checkbox" :checked true}]) + "")) + (is (= (html {:mode :sgml} [:input {:type "checkbox" :checked true}]) + ""))) + (testing "laziness and binding scope" + (is (= (html {:mode :sgml} [:html [:link] (list [:link])]) + "")))) diff --git a/test-resources/lib_tests/hiccup2/core_test.clj b/test-resources/lib_tests/hiccup2/core_test.clj new file mode 100644 index 00000000..6ab41386 --- /dev/null +++ b/test-resources/lib_tests/hiccup2/core_test.clj @@ -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])) "

"))) + +(deftest tag-names + (testing "basic tags" + (is (= (str (html [:div])) "
")) + (is (= (str (html ["div"])) "
")) + (is (= (str (html ['div])) "
"))) + (testing "tag syntax sugar" + (is (= (str (html [:div#foo])) "
")) + (is (= (str (html [:div.foo])) "
")) + (is (= (str (html [:div.foo (str "bar" "baz")])) + "
barbaz
")) + (is (= (str (html [:div.a.b])) "
")) + (is (= (str (html [:div.a.b.c])) "
")) + (is (= (str (html [:div#foo.bar.baz])) + "
")))) + +(deftest tag-contents + (testing "empty tags" + (is (= (str (html [:div])) "
")) + (is (= (str (html [:h1])) "

")) + (is (= (str (html [:script])) "")) + (is (= (str (html [:text])) "")) + (is (= (str (html [:a])) "")) + (is (= (str (html [:iframe])) "")) + (is (= (str (html [:title])) "")) + (is (= (str (html [:section])) "
")) + (is (= (str (html [:select])) "")) + (is (= (str (html [:object])) "")) + (is (= (str (html [:video])) ""))) + (testing "void tags" + (is (= (str (html [:br])) "
")) + (is (= (str (html [:link])) "")) + (is (= (str (html [:colgroup {:span 2}])) "")) + (is (= (str (html [:colgroup [:col]])) ""))) + (testing "tags containing text" + (is (= (str (html [:text "Lorem Ipsum"])) "Lorem Ipsum"))) + (testing "contents are concatenated" + (is (= (str (html [:body "foo" "bar"])) "foobar")) + (is (= (str (html [:body [:p] [:br]])) "


"))) + (testing "seqs are expanded" + (is (= (str (html [:body (list "foo" "bar")])) "foobar")) + (is (= (str (html (list [:p "a"] [:p "b"]))) "

a

b

"))) + (testing "keywords are turned into strings" + (is (= (str (html [:div :foo])) "
foo
"))) + (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]])) "

")) + (is (= (str (html [:div [:b]])) "
")) + (is (= (str (html [:p [:span [:a "foo"]]])) + "

foo

")))) + +(deftest tag-attributes + (testing "tag with blank attribute map" + (is (= (str (html [:xml {}])) ""))) + (testing "tag with populated attribute map" + (is (= (str (html [:xml {:a "1", :b "2"}])) "")) + (is (= (str (html [:img {"id" "foo"}])) "")) + (is (= (str (html [:img {'id "foo"}])) "")) + (is (= (str (html [:xml {:a "1", 'b "2", "c" "3"}])) + ""))) + (testing "attribute values are escaped" + (is (= (str (html [:div {:id "\""}])) "
"))) + (testing "boolean attributes" + (is (= (str (html [:input {:type "checkbox" :checked true}])) + "")) + (is (= (str (html [:input {:type "checkbox" :checked false}])) + ""))) + (testing "nil attributes" + (is (= (str (html [:span {:class nil} "foo"])) + "foo"))) + (testing "vector attributes" + (is (= (str (html [:span {:class ["bar" "baz"]} "foo"])) + "foo")) + (is (= (str (html [:span {:class ["baz"]} "foo"])) + "foo")) + (is (= (str (html [:span {:class "baz bar"} "foo"])) + "foo"))) + (testing "map attributes" + (is (= (str (html [:span {:style {:color "red" :opacity "100%"}} "foo"])) + "foo"))) + (testing "resolving conflicts between attributes in the map and tag" + (is (= (str (html [:div.foo {:class "bar"} "baz"])) + "
baz
")) + (is (= (str (html [:div.foo {:class ["bar"]} "baz"])) + "
baz
")) + (is (= (str (html [:div#bar.foo {:id "baq"} "baz"])) + "
baz
")))) + +(deftest compiled-tags + (testing "tag content can be vars" + (is (= (let [x "foo"] (str (html [:span x]))) "foo"))) + (testing "tag content can be forms" + (is (= (str (html [:span (str (+ 1 1))])) "2")) + (is (= (str (html [:span ({:foo "bar"} :foo)])) "bar"))) + (testing "attributes can contain vars" + (let [x "foo"] + (is (= (str (html [:xml {:x x}])) "")) + (is (= (str (html [:xml {x "x"}])) "")) + (is (= (str (html [:xml {:x x} "bar"])) "bar")))) + (testing "attributes are evaluated" + (is (= (str (html [:img {:src (str "/foo" "/bar")}])) + "")) + (is (= (str (html [:div {:id (str "a" "b")} (str "foo")])) + "
foo
"))) + (testing "type hints" + (let [string "x"] + (is (= (str (html [:span ^String string])) "x")))) + (testing "optimized forms" + (is (= (str (html [:ul (for [n (range 3)] + [:li n])])) + "")) + (is (= (str (html [:div (if true + [:span "foo"] + [:span "bar"])])) + "
foo
"))) + (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])) "


")) + (is (= (str (html {:mode :xhtml} [:p] [:br])) "


")) + (is (= (str (html {:mode :html} [:p] [:br])) "


")) + (is (= (str (html {:mode :xml} [:p] [:br])) "


")) + (is (= (str (html {:mode :sgml} [:p] [:br])) "


"))) + (testing "boolean attributes" + (is (= (str (html {:mode :xml} [:input {:type "checkbox" :checked true}])) + "")) + (is (= (str (html {:mode :sgml} [:input {:type "checkbox" :checked true}])) + ""))) + (testing "laziness and binding scope" + (is (= (str (html {:mode :sgml} [:html [:link] (list [:link])])) + ""))) + (testing "function binding scope" + (let [f #(html [:p "<>" [:br]])] + (is (= (str (html (f))) "

<>

")) + (is (= (str (html {:escape-strings? false} (f))) "

<>

")) + (is (= (str (html {:mode :html} (f))) "

<>

")) + (is (= (str (html {:escape-strings? false, :mode :html} (f))) "

<>

"))))) + +(deftest auto-escaping + (testing "literals" + (is (= (str (html "<>")) "<>")) + (is (= (str (html :<>)) "<>")) + (is (= (str (html ^String (str "<>"))) "<>")) + (is (= (str (html {} {"" ""})) "{"<a>" "<b>"}")) + (is (= (str (html #{"<>"})) "#{"<>"}")) + (is (= (str (html 1)) "1")) + (is (= (str (html ^Number (+ 1 1))) "2"))) + (testing "non-literals" + (is (= (str (html (list [:p ""] [:p ""]))) + "

<foo>

<bar>

")) + (is (= (str (html ((constantly "")))) "<foo>")) + (is (= (let [x ""] (str (html x))) "<foo>"))) + (testing "optimized forms" + (is (= (str (html (if true : :))) "<foo>")) + (is (= (str (html (for [x [:]] x))) "<foo>"))) + (testing "elements" + (is (= (str (html [:p "<>"])) "

<>

")) + (is (= (str (html [:p :<>])) "

<>

")) + (is (= (str (html [:p {} {"" ""}])) + "

{"<foo>" "<bar>"}

")) + (is (= (str (html [:p {} #{""}])) + "

#{"<foo>"}

")) + (is (= (str (html [:p {:class "<\">"}])) + "

")) + (is (= (str (html [:p {:class ["<\">"]}])) + "

")) + (is (= (str (html [:ul [:li ""]])) + "
  • <foo>
"))) + (testing "raw strings" + #_(is (= (str (html (util/raw-string ""))) "")) + (is (= (str (html [:p (util/raw-string "")])) "

")) + (is (= (str (html (html [:p "<>"]))) "

<>

")) + (is (= (str (html [:ul (html [:li "<>"])])) "
  • <>
")))) + +(deftest html-escaping + (testing "precompilation" + (is (= (str (html {:escape-strings? true} [:p "<>"])) "

<>

")) + (is (= (str (html {:escape-strings? false} [:p "<>"])) "

<>

"))) + (testing "dynamic generation" + (let [x [:p "<>"]] + (is (= (str (html {:escape-strings? true} x)) "

<>

")) + (is (= (str (html {:escape-strings? false} x)) "

<>

")))) + (testing "attributes" + (is (= (str (html {:escape-strings? true} [:p {:class "<>"}])) + "

")) + (is (= (str (html {:escape-strings? false} [:p {:class "<>"}])) + "

"))) + (testing "raw strings" + (is (= (str (html {:escape-strings? true} [:p (util/raw-string "<>")])) + "

<>

")) + (is (= (str (html {:escape-strings? false} [:p (util/raw-string "<>")])) + "

<>

")) + #_(is (= (str (html {:escape-strings? true} [:p (raw "<>")])) + "

<>

")) + #_(is (= (str (html {:escape-strings? false} [:p (raw "<>")])) + "

<>

"))))