diff --git a/project.clj b/project.clj index 0edb393..635100e 100644 --- a/project.clj +++ b/project.clj @@ -19,7 +19,7 @@ commons-codec]] [ring/ring-json "0.5.0"] [hiccup "1.0.5"] - [joshavg/formulare "0.6.0"] + ;[joshavg/formulare "0.6.0"] ;; compojure uses old transitive dependencies of ring ;; specifiy them here explicitly so newer versions diff --git a/src/formulare/core.clj b/src/formulare/core.clj new file mode 100644 index 0000000..5f7d95b --- /dev/null +++ b/src/formulare/core.clj @@ -0,0 +1,168 @@ +(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 :file}) +(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) +(def ^:dynamic *file-widget-theme* theme/file-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* + :file *file-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) diff --git a/src/formulare/theme.clj b/src/formulare/theme.clj new file mode 100644 index 0000000..c68a6b1 --- /dev/null +++ b/src/formulare/theme.clj @@ -0,0 +1,85 @@ +(ns formulare.theme + (:require [clojure.spec.alpha :as spec] + [hiccup + [form :as hform] + [core :as hcore]])) + +(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 + (hcore/h (:label field-def))] + " must comply to " + [:span.flash__pred + (hcore/h (: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 " + (hcore/h (: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 (merge {:required (or (:required def) false)} + (:attrs def)) + 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 (merge {:required (or (:required def) false)} + (:attrs def)) + id + value)) + +(defn select-widget [id def value] + (hform/drop-down id + (:options def) + value)) + +(defn multiselect-widget [id def value] + [:select (merge {:multiple "multiple" + :size (:size def 5) + :name (name id) + :id (name id)} + (:attrs def)) + (for [option (:options def)] + [:option {:value (second option) + :selected (some? (some (partial = (second option)) + value))} + (hcore/h (first option))])]) + +(comment + (multiselect-widget :id {:options [["<>" "key"]]} {})) + +(defn hidden-widget [id _ value] + (hform/hidden-field id value)) + +(defn file-widget [id def value] + [:input {:type :file + :name id + :required (or (:required def) false) + :value value}]) diff --git a/src/wanijo/attribute/domain.clj b/src/wanijo/attribute/domain.clj index 080b6e1..a31e0ce 100644 --- a/src/wanijo/attribute/domain.clj +++ b/src/wanijo/attribute/domain.clj @@ -3,7 +3,7 @@ [clojure.spec.alpha :as spec])) (def types - #{"string" "markdown"}) + #{"string" "markdown" "file"}) (spec/def ::type types) (spec/def ::name (spec/and ::specs/name (complement empty?))) diff --git a/src/wanijo/instance/forms.clj b/src/wanijo/instance/forms.clj index 1103c2a..c6959e1 100644 --- a/src/wanijo/instance/forms.clj +++ b/src/wanijo/instance/forms.clj @@ -34,6 +34,7 @@ (defn attr-type->widget [attr-type] (case attr-type ("markdown" "text") :textarea + "file" :file :input)) (defn attr->field-id [attr] diff --git a/src/wanijo/instance/routes.clj b/src/wanijo/instance/routes.clj index 7ff2bb1..77d7ff5 100644 --- a/src/wanijo/instance/routes.clj +++ b/src/wanijo/instance/routes.clj @@ -57,24 +57,27 @@ (domain-schema/accessible-schemas! user-uuid) req))) -(defn form! [attrs] - (forms-inst/with-attributes attrs)) - (defn route-edit-form! [uuid req] (let [instance (instance! uuid) attrs (db-attr/find-by-instance! uuid) user-uuid (get-in req [:session :uuid])] (edit instance - (form! attrs) + (forms-inst/with-attributes attrs) (forms-inst/instance->form-data instance) (domain-schema/accessible-schemas! user-uuid) req))) +(comment + (forms-inst/with-attributes + (db-attr/find-by-instance! + "def4dacb-979f-4a0d-b1d6-535ac2a3f94b"))) + (defn route-edit! [uuid req] (let [attrs (db-attr/find-by-instance! uuid) - form-def (form! attrs)] + form-def (forms-inst/with-attributes attrs)] (if (form/valid? form-def req) (let [form-data (form/form-data form-def req) + _ (clojure.pprint/pprint req) form-instance (forms-inst/form-data->instance form-data attrs) instance (assoc form-instance :uuid uuid)] (db/edit! instance (domain/to-revision instance)) diff --git a/src/wanijo/instance/view/edit.clj b/src/wanijo/instance/view/edit.clj index d3e793a..cf225fb 100644 --- a/src/wanijo/instance/view/edit.clj +++ b/src/wanijo/instance/view/edit.clj @@ -26,9 +26,11 @@ "Back to Instance"]]] [:section.edit-instance [:h2 "Edit Instance"] - (hform/form-to [:post (path :instance-edit instance)] - (form/render-widgets form form-data req) - (hform/submit-button "Edit!")) + [:form {:method "post" + :action (path :instance-edit instance) + :enctype "multipart/form-data"} + (form/render-widgets form form-data req) + (hform/submit-button "Edit!")] (hform/form-to [:delete (path :instance-delete instance)] (anti-forgery-field) (view/delete-btn))]