add support for custom themes

master
Josha von Gizycki 6 years ago
parent d8b5e6d022
commit 04e14c7455

@ -1,5 +1,6 @@
(ns formulare.core
(:require [clojure.spec.alpha :as spec]
(:require [formulare.theme :as theme]
[clojure.spec.alpha :as spec]
[hiccup.form :as hform]
[hiccup.core :as hcore]
[ring.util.anti-forgery :refer [anti-forgery-field]]))
@ -36,27 +37,6 @@
(spec/keys :req-un [::fields]
:opt-un [::form-specs]))
(defn err-msg [content]
[:section.flash--error
[:h2.flash__heading--error "Warning"]
content])
(defn spec-to-errmsg [label spec-key field-value]
(err-msg
(map
(fn [prob]
[:p
"Field "
[:span.flash__field label]
" must comply to "
[:span.flash__pred (:pred prob)]])
(:clojure.spec.alpha/problems
(spec/explain-data spec-key field-value)))))
(defn field-valid?[value spec-key req]
(or (empty? (:form-params req))
(spec/valid? spec-key value)))
(defn valid? [form-def req]
{:pre [(spec/assert ::form form-def)]}
(reduce-kv
@ -71,70 +51,40 @@
true
(:params req)))
(defn input-widget [id def value]
(hform/text-field {:required (or (:required def) false)}
id
value))
(defn checkbox-widget [id def value]
(hform/check-box id
(and (some? value)
(not= 0 value))
value))
(defn textarea-widget [id def value]
(hform/text-area {:required (or (:required def) false)}
id
value))
(defn select-widget [id def value]
(hform/drop-down id
(:options def)
value))
(defn multiselect-widget [id def value]
(let [options (:options def)]
[:select {:multiple "multiple"
:size 5
:name (name id)
:id (name id)}
(for [option options]
[:option {:value (second option)
:selected (in? value (second option))}
(first option)])]))
(defn hidden-widget [id def value]
(hform/hidden-field id value))
(def widget-mapping
{:input input-widget
:checkbox checkbox-widget
:textarea textarea-widget
:select select-widget
:mselect multiselect-widget
:hidden hidden-widget})
(def ^:dynamic *row-theme* theme/row)
(def ^:dynamic *widget-error-theme* theme/widget-error)
(def ^:dynamic *form-error-theme* theme/form-error)
(def ^:dynamic *label-theme* theme/label)
(def ^:dynamic *input-widget-theme* theme/input-widget)
(def ^:dynamic *checkbox-widget-theme* theme/checkbox-widget)
(def ^:dynamic *textarea-widget-theme* theme/textarea-widget)
(def ^:dynamic *select-widget-theme* theme/select-widget)
(def ^:dynamic *mselect-widget-theme* theme/multiselect-widget)
(def ^:dynamic *hidden-widget-theme* theme/hidden-widget)
(defn widget-markup [values req validate? [id def]]
(let [{:keys [label spec widget options to-form]} def
(let [{:keys [spec widget options to-form]} def
value ((or to-form identity) (id values))
req-value (get-in req [:params id])
widget (cond (some? widget) widget
(some? options) :select
:else :input)
renderer (widget widget-mapping)]
(list
(when (and validate? (not (spec/valid? spec req-value)))
(spec-to-errmsg label spec req-value))
(when-not (= :hidden widget)
(hform/label id label))
(renderer id def (if validate? req-value value)))))
(defn form-level-errors [form-def req]
(for [prob (mapcat #(:clojure.spec.alpha/problems
(spec/explain-data % req))
(:form-specs form-def))]
(err-msg [:p "The form must comply to "
(:pred prob)])))
renderer (case widget
:checkbox *checkbox-widget-theme*
:textarea *textarea-widget-theme*
:select *select-widget-theme*
:mselect *mselect-widget-theme*
:hidden *hidden-widget-theme*
*input-widget-theme*)]
(*row-theme* (when (and validate? (not (spec/valid? spec req-value)))
(*widget-error-theme* id def req-value))
(*label-theme* id def)
(renderer id def (if validate? req-value value)))))
(defn form-specs-valid? [form-def req]
(reduce (fn [valid? field-spec]
(if (spec/valid? field-spec (:params req))
true
(reduced false)))
true
(:form-specs form-def)))
(defn form-hash [form-def values]
(str (hash [form-def values])))
@ -145,18 +95,24 @@
(defn render-widgets [form-def values req]
(when-not (spec/valid? ::form form-def)
(throw (ex-info "Form def fails spec" (spec/explain-data ::form form-def))))
(throw (ex-info "Form def fails spec"
(spec/explain-data ::form form-def))))
(let [validate? (validate? form-def values req)
form-errors (when validate? (form-level-errors form-def req))
all-widgets (conj (map
(partial widget-markup
values req validate?)
(:fields form-def))
(hform/hidden-field "__form-hash"
(form-hash form-def values))
form-errors (when (and validate?
(not (form-specs-valid? form-def req)))
(*form-error-theme* form-def req))
widget-mapper (partial widget-markup values req validate?)
defined-widgets (map widget-mapper (:fields form-def))
hash-field (hform/hidden-field "__form-hash"
(form-hash form-def values))
all-widgets (conj defined-widgets
hash-field
(anti-forgery-field))]
(if form-errors
(concat form-errors all-widgets)
(concat (if (sequential? form-errors)
form-errors
[form-errors])
all-widgets)
all-widgets)))
(defn form-data [form-def req]

@ -0,0 +1,70 @@
(ns formulare.theme
(:require [clojure.spec.alpha :as spec]
[hiccup.form :as hform]))
(defn row [& content] content)
(defn err-msg [content]
[:section.flash--error
[:h2.flash__heading--error "Warning"]
content])
(defn widget-error [id field-def field-value]
(err-msg
(map
(fn [prob]
[:p
"Field "
[:span.flash__field (:label field-def)]
" must comply to "
[:span.flash__pred (:pred prob)]])
(:clojure.spec.alpha/problems
(spec/explain-data (:spec field-def)
field-value)))))
(defn form-error [form-def req]
(for [prob (mapcat #(:clojure.spec.alpha/problems
(spec/explain-data % req))
(:form-specs form-def))]
(err-msg [:p "The form must comply to "
(:pred prob)])))
(defn label [field-id field-def]
(when-not (= :hidden (:widget field-def))
(hform/label field-id (:label field-def))))
(defn input-widget [id def value]
(hform/text-field {:required (or (:required def) false)}
id
value))
(defn checkbox-widget [id def value]
(hform/check-box id
(and (some? value)
(not= 0 value))
value))
(defn textarea-widget [id def value]
(hform/text-area {:required (or (:required def) false)}
id
value))
(defn select-widget [id def value]
(hform/drop-down id
(:options def)
value))
(defn multiselect-widget [id def value]
(let [options (:options def)]
[:select {:multiple "multiple"
:size 5
:name (name id)
:id (name id)}
(for [option options]
[:option {:value (second option)
:selected (some? (some (partial = (second option))
value))}
(first option)])]))
(defn hidden-widget [id def value]
(hform/hidden-field id value))

@ -0,0 +1,92 @@
(ns formulare.theme-test
(:require [clojure.test :refer :all]
[formulare.core :refer :all]))
(deftest row-is-overridable
(binding [*row-theme* (fn [& content] [1])]
(is (= [1]
(nth (render-widgets {:fields {:foo {}}} {} {})
2)))))
(deftest widget-error-is-overridable
(binding [*widget-error-theme* (fn [& args] \a)]
(let [def {:fields {:foo {:spec (fn [_] false)}}}
hash (form-hash def {})]
(is (= \a
(-> (render-widgets def {}
{:params {:__form-hash hash}})
(nth 2)
first))))))
(deftest form-error-is-overridable
(binding [*form-error-theme* (fn [& args] \a)]
(let [def {:fields {:foo {:spec (fn [_] false)}}
:form-specs [(fn [_] false)]}
hash (form-hash def {})]
(is (= \a
(first (render-widgets def {}
{:params {:__form-hash hash}})))))))
(deftest label-is-overridable
(binding [*label-theme* (fn [& _] \a)]
(is (= \a
(-> (render-widgets {:fields {:foo {:label "b"}}}
{} {})
(nth 2)
(nth 1))))))
(deftest input-is-overridable
(binding [*input-widget-theme* (fn [& _] \a)]
(is (= \a
(-> (render-widgets {:fields {:foo {}}}
{} {})
(nth 2)
(nth 2))))))
(deftest checkbox-is-overridable
(binding [*checkbox-widget-theme* (fn [& _] \a)]
(is (= \a
(-> (render-widgets {:fields {:foo {:widget :checkbox}}}
{} {})
(nth 2)
(nth 2))))))
(deftest checkbox-is-overridable
(binding [*checkbox-widget-theme* (fn [& _] \a)]
(is (= \a
(-> (render-widgets {:fields {:foo {:widget :checkbox}}}
{} {})
(nth 2)
(nth 2))))))
(deftest textarea-is-overridable
(binding [*textarea-widget-theme* (fn [& _] \a)]
(is (= \a
(-> (render-widgets {:fields {:foo {:widget :textarea}}}
{} {})
(nth 2)
(nth 2))))))
(deftest select-is-overridable
(binding [*select-widget-theme* (fn [& _] \a)]
(is (= \a
(-> (render-widgets {:fields {:foo {:widget :select}}}
{} {})
(nth 2)
(nth 2))))))
(deftest mselect-is-overridable
(binding [*mselect-widget-theme* (fn [& _] \a)]
(is (= \a
(-> (render-widgets {:fields {:foo {:widget :mselect}}}
{} {})
(nth 2)
(nth 2))))))
(deftest hidden-is-overridable
(binding [*hidden-widget-theme* (fn [& _] \a)]
(is (= \a
(-> (render-widgets {:fields {:foo {:widget :hidden}}}
{} {})
(nth 2)
(nth 2))))))
Loading…
Cancel
Save