formulare/src/formulare/core.clj

(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
  (spec/or :registered-spec keyword?
           :predicate ifn?))
(spec/def ::options
  (spec/or :empty empty?
           :options (spec/coll-of (spec/tuple string? string?))))
(spec/def ::widget
  #{:input :select :checkbox :textarea :mselect :hidden})
(spec/def ::from-req
  (spec/and ifn? #_(= 1 (->> % meta :arglists (map count) first))))
(spec/def ::to-form ::from-req)
(spec/def ::field
  (spec/keys :opt-un [::label
                      ::options
                      ::widget
                      ::from-req
                      ::to-form
                      ::required
                      ::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]
             :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
   (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)])]))

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

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

(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 [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))
                          (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)
    (throw (ex-info "Form def fails spec" (spec/explain-data ::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)))