add support for custom themes

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]

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))

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))))))