You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
150 lines
4.6 KiB
150 lines
4.6 KiB
(ns formulare.core
|
|
(:require [clojure.spec.alpha :as spec]
|
|
[hiccup.form :as hform]
|
|
[hiccup.core :as hcore]
|
|
[ring.util.anti-forgery :refer [anti-forgery-field]]))
|
|
|
|
(defn in? [coll x]
|
|
(some? (some (partial = x) coll)))
|
|
|
|
(spec/def ::label string?)
|
|
(spec/def ::required boolean?)
|
|
(spec/def ::spec keyword?)
|
|
(spec/def ::options
|
|
(spec/or :empty empty?
|
|
:options (spec/coll-of (spec/tuple string? string?))))
|
|
(spec/def ::widget
|
|
#(in? [:input :select :checkbox :textarea :mselect] %))
|
|
(spec/def ::from-req
|
|
(spec/and fn? #(= 1 (->> % meta :arglists (map count) first))))
|
|
(spec/def ::to-form ::from-req)
|
|
(spec/def ::field
|
|
(spec/keys :req-un [::label]
|
|
:opt-un [::options
|
|
::widget
|
|
::from-req
|
|
::to-form
|
|
::required
|
|
::spec]))
|
|
(spec/def ::fields
|
|
(spec/map-of keyword? ::field))
|
|
(spec/def ::form
|
|
(spec/keys :req-un [::fields]))
|
|
|
|
(defn spec-to-errmsg [label spec-key field-value]
|
|
[:section.flash--error
|
|
[:h2.flash__heading--error "Warning"]
|
|
(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
|
|
(fn [result field value]
|
|
(if-let [field-spec (get-in form-def [:fields field :spec])]
|
|
(let [from-req (get-in form-def [:fields field :from-req])
|
|
check-value (if from-req (from-req value) value)]
|
|
(if (spec/valid? field-spec check-value)
|
|
true
|
|
(reduced false)))
|
|
result))
|
|
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)])]))
|
|
|
|
(def widget-mapping
|
|
{:input input-widget
|
|
:checkbox checkbox-widget
|
|
:textarea textarea-widget
|
|
:select select-widget
|
|
:mselect multiselect-widget})
|
|
|
|
(defn widget-markup
|
|
[id def value req-value validate?]
|
|
(let [{:keys [label spec widget options]} def
|
|
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))
|
|
(hform/label id label)
|
|
(renderer id def (if validate? req-value value)))))
|
|
|
|
(defn form-hash [def values]
|
|
(str (hash [def values])))
|
|
|
|
(defn render-widgets [form-def values req]
|
|
{:pre [(spec/assert ::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?)))
|
|
(:fields form-def))
|
|
(hform/hidden-field "__form-hash" form-hash)
|
|
(anti-forgery-field))))
|
|
|
|
(defn form-data [form-def req]
|
|
{:pre [(spec/assert ::form form-def)]}
|
|
(reduce (fn [coll [id field]]
|
|
(let [value (get-in req [:params id])]
|
|
(assoc coll
|
|
id
|
|
(if-let [from-req (:from-req field)]
|
|
(from-req value)
|
|
value))))
|
|
{}
|
|
(:fields form-def)))
|