|
|
|
@ -18,8 +18,7 @@
|
|
|
|
|
(spec/def ::widget
|
|
|
|
|
#{:input :select :checkbox :textarea :mselect :hidden})
|
|
|
|
|
(spec/def ::from-req
|
|
|
|
|
(spec/and ifn? ;;#(= 1 (->> % meta :arglists (map count) first))
|
|
|
|
|
))
|
|
|
|
|
(spec/and ifn? #_(= 1 (->> % meta :arglists (map count) first))))
|
|
|
|
|
(spec/def ::to-form ::from-req)
|
|
|
|
|
(spec/def ::field
|
|
|
|
|
(spec/keys :opt-un [::label
|
|
|
|
@ -31,12 +30,19 @@
|
|
|
|
|
::spec]))
|
|
|
|
|
(spec/def ::fields
|
|
|
|
|
(spec/map-of keyword? ::field))
|
|
|
|
|
(spec/def ::form-specs
|
|
|
|
|
(spec/coll-of ::spec))
|
|
|
|
|
(spec/def ::form
|
|
|
|
|
(spec/keys :req-un [::fields]))
|
|
|
|
|
(spec/keys :req-un [::fields]
|
|
|
|
|
:opt-un [::form-specs]))
|
|
|
|
|
|
|
|
|
|
(defn spec-to-errmsg [label spec-key field-value]
|
|
|
|
|
(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
|
|
|
|
@ -45,7 +51,7 @@
|
|
|
|
|
" must comply to "
|
|
|
|
|
[:span.flash__pred (:pred prob)]])
|
|
|
|
|
(:clojure.spec.alpha/problems
|
|
|
|
|
(spec/explain-data spec-key field-value)))])
|
|
|
|
|
(spec/explain-data spec-key field-value)))))
|
|
|
|
|
|
|
|
|
|
(defn field-valid?[value spec-key req]
|
|
|
|
|
(or (empty? (:form-params req))
|
|
|
|
@ -108,9 +114,10 @@
|
|
|
|
|
:mselect multiselect-widget
|
|
|
|
|
:hidden hidden-widget})
|
|
|
|
|
|
|
|
|
|
(defn widget-markup
|
|
|
|
|
[id def value req-value validate?]
|
|
|
|
|
(let [{:keys [label spec widget options]} def
|
|
|
|
|
(defn widget-markup [values req validate? [id def]]
|
|
|
|
|
(let [{:keys [label 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)
|
|
|
|
@ -122,28 +129,35 @@
|
|
|
|
|
(hform/label id label))
|
|
|
|
|
(renderer id def (if validate? req-value value)))))
|
|
|
|
|
|
|
|
|
|
(defn form-hash [def values]
|
|
|
|
|
(str (hash [def values])))
|
|
|
|
|
(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)])))
|
|
|
|
|
|
|
|
|
|
(defn form-hash [form-def values]
|
|
|
|
|
(str (hash [form-def values])))
|
|
|
|
|
|
|
|
|
|
(defn validate? [form-def values req]
|
|
|
|
|
(= (form-hash form-def values)
|
|
|
|
|
(get-in req [:params :__form-hash])))
|
|
|
|
|
|
|
|
|
|
(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))))
|
|
|
|
|
(let [form-hash (form-hash form-def values)
|
|
|
|
|
submitted-hash (get-in req [:params :__form-hash])
|
|
|
|
|
validate? (= form-hash submitted-hash)]
|
|
|
|
|
(conj (map
|
|
|
|
|
(fn [[field-id field-def]]
|
|
|
|
|
(let [{:keys [options to-form]} field-def
|
|
|
|
|
value (field-id values)
|
|
|
|
|
req-value (get-in req [:params field-id])]
|
|
|
|
|
(widget-markup field-id
|
|
|
|
|
field-def
|
|
|
|
|
(if to-form (to-form value) value)
|
|
|
|
|
req-value
|
|
|
|
|
validate?)))
|
|
|
|
|
(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)
|
|
|
|
|
(anti-forgery-field))))
|
|
|
|
|
(hform/hidden-field "__form-hash"
|
|
|
|
|
(form-hash form-def values))
|
|
|
|
|
(anti-forgery-field))]
|
|
|
|
|
(if form-errors
|
|
|
|
|
(concat form-errors all-widgets)
|
|
|
|
|
all-widgets)))
|
|
|
|
|
|
|
|
|
|
(defn form-data [form-def req]
|
|
|
|
|
(when-not (spec/valid? ::form form-def)
|
|
|
|
|