preparations for file upload - move formulare into wanijo

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

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)

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

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?)))

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]

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

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 {:method "post"
+              :action (path :instance-edit instance)
+              :enctype "multipart/form-data"}
        (form/render-widgets form form-data req)
-                     (hform/submit-button "Edit!"))
+       (hform/submit-button "Edit!")]
       (hform/form-to [:delete (path :instance-delete instance)]
                      (anti-forgery-field)
                      (view/delete-btn))]