initial commit

.gitignore

@@ -0,0 +1,11 @@
+/target
+/classes
+/checkouts
+pom.xml
+pom.xml.asc
+*.jar
+*.class
+/.lein-*
+/.nrepl-port
+.hgignore
+.hg/

CHANGELOG.md

@@ -0,0 +1 @@
+

README.md

@@ -0,0 +1,11 @@
+# formulare
+
+A Clojure library designed to render predefined forms.
+
+## Usage
+
+FIXME
+
+## License
+
+Copyright © 2018 GPL 3

project.clj

@@ -0,0 +1,8 @@
+(defproject formulare "0.1.0"
+  :description "Forms hiccup style"
+  :url "https://gitea.heevyis.ninja/josha/formulare.git"
+  :license {:name "GPL-3.0"
+            :url "https://opensource.org/licenses/GPL-3.0"}
+  :dependencies [[org.clojure/clojure "1.9.0"]
+                 [hiccup "1.0.5"]
+                 [ring/ring-anti-forgery "1.3.0"]])

src/formulare/core.clj

@@ -0,0 +1,149 @@
+(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)))

test/formulare/core_test.clj

@@ -0,0 +1,206 @@
+(ns formulare.core-test
+  (:require [clojure.test :refer :all]
+            [formulare.core :refer :all]
+            [clojure.string :refer [starts-with?]]
+            [clojure.spec.alpha :as spec]))
+
+
+(deftest test-form-data
+  (testing "no from-req is given"
+    (let [def {:fields {:name {:label ""
+                               :required false
+                               :spec :a}}}]
+      (is (= {:name "a"}
+             (form-data def {:params {:name "a"}})))
+      (is (= {:name nil}
+             (form-data def {:params {}})))))
+  (testing "from-req is called"
+    (let [def {:fields {:name {:label ""
+                               :required false
+                               :spec :a
+                               :from-req #(str "foo" %)}}}]
+      (is (= {:name "foo"}
+             (form-data def {:params {}})))
+      (is (= {:name "fooa"}
+             (form-data def {:params {:name "a"}})))))
+  (testing "from-req is given in one field, not in another"
+    (let [def {:fields {:foo {:label ""
+                              :spec number?
+                              :from-req bigint}
+                        :bar {:label ""
+                              :spec string?}}}]
+      (is (= {:foo 5
+              :bar "a"}
+             (form-data def {:params {:foo "5"
+                                      :bar "a"}})))))
+  (testing "type conversion"
+    (let [def {:fields {:foo {:label ""
+                              :required false
+                              :spec :a
+                              :from-req bigint}}}]
+      (is (= {:foo 5}
+             (form-data def {:params {:foo 5}}))))))
+
+(deftest test-valid?
+  (testing "required-key does not change validity of the form"
+    (let [def {:fields {:name {:label ""
+                               :spec nil?
+                               :required true}}}]
+      (is (= true (valid? def {:params {:name nil}}))))
+    (let [def {:fields {:name {:label ""
+                               :spec nil?
+                               :required false}}}]
+      (is (= true (valid? def {:params {:name nil}})))))
+  (testing "converted values are passed to spec"
+    (let [def {:fields {:foo {:label ""
+                              :spec number?
+                              :from-req bigint}
+                        :bar {:label ""
+                              :spec string?}}}]
+      (is (= true (valid? def {:params {:foo "5"
+                                        :bar "a"}}))))))
+
+(deftest test-render-widgets
+  (testing "form-hash is rendered"
+    (let [def {:fields {}}]
+      (is (= (list [:input {:type "hidden"
+                            :name "__form-hash"
+                            :id "__form-hash"
+                            :value (form-hash def {})}])
+             (rest (render-widgets def {} {}))))))
+  (testing "anti-forgery-field is rendered"
+    (let [def {:fields {}}]
+      (is (starts-with? (first (render-widgets def {} {}))
+                        (str "<input id=\"__anti-forgery-token\""
+                             " name=\"__anti-forgery-token\""
+                             " type=\"hidden\"")))))
+  (testing "input is rendered correctly"
+    (let [def {:fields {:foo-id {:label "foo-label"
+                                 :widget :input}}}]
+      (is (= (list nil
+                   [:label {:for "foo-id"} "foo-label"]
+                   [:input {:id "foo-id"
+                            :name "foo-id"
+                            :required false
+                            :type "text"
+                            :value nil}])
+             (first
+              (nthrest
+               (render-widgets def {} {})
+               2)))))
+    (let [def {:fields {:foo-id {:label "foo-label"
+                                 :required true
+                                 :widget :input}}}]
+      (is (= (list nil
+                   [:label {:for "foo-id"} "foo-label"]
+                   [:input {:id "foo-id"
+                            :name "foo-id"
+                            :required true
+                            :type "text"
+                            :value nil}])
+             (first
+              (nthrest
+               (render-widgets def {} {})
+               2)))))
+    (testing "input is default"
+      (let [def {:fields {:foo-id {:label "foo-label"
+                                   :required true}}}]
+        (is (= (list nil
+                     [:label {:for "foo-id"} "foo-label"]
+                     [:input {:id "foo-id"
+                              :name "foo-id"
+                              :required true
+                              :type "text"
+                              :value nil}])
+               (first
+                (nthrest
+                 (render-widgets def {} {})
+                 2)))))))
+  (testing "checkbox is rendered correctly"
+    (let [def {:fields {:foo-id {:label "foo-label"
+                                 :widget :checkbox}}}]
+      (is (= (list nil
+                   [:label {:for "foo-id"} "foo-label"]
+                   [:input {:id "foo-id"
+                            :name "foo-id"
+                            :checked false
+                            :type "checkbox"
+                            :value nil}])
+             (first
+              (nthrest
+               (render-widgets def {} {})
+               2)))))
+    (let [def {:fields {:foo-id {:label "foo-label"
+                                 :required true
+                                 :widget :checkbox}}}]
+      (is (= (list nil
+                   [:label {:for "foo-id"} "foo-label"]
+                   [:input {:id "foo-id"
+                            :name "foo-id"
+                            :checked false
+                            :type "checkbox"
+                            :value nil}])
+             (first
+              (nthrest
+               (render-widgets def {} {})
+               2))))))
+  (testing "textarea is rendered correctly"
+    (let [def {:fields {:foo-id {:label "foo-label"
+                                 :widget :textarea}}}]
+      (is (= (list nil
+                   [:label {:for "foo-id"} "foo-label"]
+                   [:textarea {:id "foo-id"
+                               :name "foo-id"
+                               :required false}
+                    ""])
+             (first
+              (nthrest
+               (render-widgets def {} {})
+               2)))))
+    (let [def {:fields {:foo-id {:label "foo-label"
+                                 :required true
+                                 :widget :textarea}}}]
+      (is (= (list nil
+                   [:label {:for "foo-id"} "foo-label"]
+                   [:textarea {:id "foo-id"
+                               :name "foo-id"
+                               :required true}
+                    ""])
+             (first
+              (nthrest
+               (render-widgets def {} {})
+               2))))))
+  (testing "select is rendered correctly"
+    (let [def {:fields {:foo-id {:label "foo-label"
+                                 :widget :select
+                                 :options [["value1" "key1"]
+                                           ["value2" "key2"]]}}}]
+      (is (= (list nil
+                   [:label {:for "foo-id"} "foo-label"]
+                   [:select {:id "foo-id"
+                             :name "foo-id"}
+                    (list
+                     [:option {:value "key1" :selected false} "value1"]
+                     [:option {:value "key2" :selected false} "value2"])])
+             (first
+              (nthrest
+               (render-widgets def {} {})
+               2))))))
+  (testing "mselect is rendered correctly"
+    (let [def {:fields {:foo-id {:label "foo-label"
+                                 :widget :mselect
+                                 :options [["value1" "key1"]
+                                           ["value2" "key2"]]}}}]
+      (is (= (list nil
+                   [:label {:for "foo-id"} "foo-label"]
+                   [:select {:id "foo-id"
+                             :name "foo-id"
+                             :size 5
+                             :multiple "multiple"}
+                    (list
+                     [:option {:value "key1" :selected false} "value1"]
+                     [:option {:value "key2" :selected false} "value2"])])
+             (first
+              (nthrest
+               (render-widgets def {} {})
+               2)))))))