From 04e14c74555d9a7f2cda22ad6d1d699fcb064242 Mon Sep 17 00:00:00 2001 From: Josha von Gizycki Date: Mon, 8 Oct 2018 14:21:53 +0200 Subject: [PATCH] add support for custom themes --- src/formulare/core.clj | 138 ++++++++++++---------------------- src/formulare/theme.clj | 70 +++++++++++++++++ test/formulare/theme_test.clj | 92 +++++++++++++++++++++++ 3 files changed, 209 insertions(+), 91 deletions(-) create mode 100644 src/formulare/theme.clj create mode 100644 test/formulare/theme_test.clj diff --git a/src/formulare/core.clj b/src/formulare/core.clj index 43fedf0..d6d94c9 100644 --- a/src/formulare/core.clj +++ b/src/formulare/core.clj @@ -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] diff --git a/src/formulare/theme.clj b/src/formulare/theme.clj new file mode 100644 index 0000000..662cfbb --- /dev/null +++ b/src/formulare/theme.clj @@ -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)) diff --git a/test/formulare/theme_test.clj b/test/formulare/theme_test.clj new file mode 100644 index 0000000..d4a1e27 --- /dev/null +++ b/test/formulare/theme_test.clj @@ -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))))))