formulare/src/formulare/core.clj

(ns formulare.core
  (:require [formulare.theme :as theme]
            [clojure.spec.alpha :as spec]
            [clojure.spec.test.alpha :as spectest]
            [hiccup
             [form :as hform]
             [core :as hcore]]
            [ring.util.anti-forgery :refer [anti-forgery-field]]))

(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 ifn?)
(spec/def ::to-form ::from-req)
(spec/def ::attrs (spec/map-of keyword? (fn [_] true)))
(spec/def ::field
  (spec/keys :opt-un [::label
                      ::options
                      ::widget
                      ::from-req
                      ::to-form
                      ::required
                      ::spec
                      ::attrs]))
(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 form-data [form-def req]
  (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)))

(spec/fdef form-data
           :args (spec/cat :form-def ::form :req map?)
           :ret map?)
(spectest/instrument `form-data)

(defn form-specs-valid? [form-def req]
  (reduce (fn [valid? form-spec]
            (if (spec/valid? form-spec req)
              true
              (reduced false)))
          true
          (:form-specs form-def)))

(defn field-specs-valid? [form-def req]
  (reduce-kv
    (fn [result field field-def]
      (if-let [field-spec (:spec field-def)]
        (if (spec/valid? field-spec (get-in req [:params field]))
          true
          (reduced false))
        result))
    true
    (:fields form-def)))

(defn valid? [form-def req]
  (let [data (form-data form-def req)]
    (and (field-specs-valid? form-def req)
         (form-specs-valid? form-def req))))

(spec/fdef valid?
           :args (spec/cat :form-def ::form :req map?)
           :ret map?)
(spectest/instrument `valid?)

(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 [spec widget to-form]} def
        value ((or to-form identity) (id values))
        req-value (get-in req [:params id])
        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?
                            spec
                            (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-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]
   (render-widgets form-def values req
                   {:render-anti-forgery-field? true}))
  ([form-def values req {raff? :render-anti-forgery-field?}]
   (let [validate? (validate? form-def values req)
         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)
         all-widgets (if raff?
                       (conj all-widgets (anti-forgery-field))
                       all-widgets)]
     (if form-errors
       (concat (if (sequential? form-errors)
                 form-errors
                 [form-errors])
               all-widgets)
       all-widgets))))

(spec/def ::render-anti-forgery-field?
  #(boolean? (boolean %)))

(spec/def ::options-map
  (spec/keys :req-un
             [::render-anti-forgery-field?]))

(spec/fdef render-widgets
           :args (spec/or :three-params
                          (spec/cat :form-def ::form
                                    :values (spec/or :no-values nil?
                                                     :values map?)
                                    :req map?)
                          :four-params
                          (spec/cat :form-def ::form
                                    :values (spec/or :no-values nil?
                                                     :values map?)
                                    :req map?
                                    :options ::options-map)))
(spectest/instrument `render-widgets)