Makes the entire form work but it just looks janky

This commit is contained in:
2023-10-19 22:11:19 -07:00
parent 6059e8a4ca
commit 6863684d9e
21 changed files with 1334 additions and 181 deletions

View File

@@ -8,7 +8,8 @@
[malli.core :as mc]
[malli.error :as me]
[malli.transform :as mt2]
[slingshot.slingshot :refer [throw+ try+]]))
[slingshot.slingshot :refer [throw+ try+]]
[manifold.time :as mt]))
(defn html-response [hiccup & {:keys [status headers oob] :or {status 200 headers {} oob []}}]
{:status status
@@ -83,8 +84,55 @@
)}}
x])
(def entity-id (mc/schema nat-int?))
(defn empty->nil [v]
(if (and (string? v) (clojure.string/blank? v))
nil
v))
(defn parse-empty-as-nil []
(mt2/transformer
{:decoders
{:double empty->nil
:int empty->nil
:long empty->nil
'nat-int? empty->nil}}))
(def entity-id (mc/schema [nat-int? {:error/message "required"} ]))
(def temp-id (mc/schema :string))
(def money (mc/schema [:double]))
(def percentage (mc/schema [:double {:decode/arbitrary (fn [x] (some-> x (* 0.01)))
:max 1.0
:error/message "1-100"}]))
(def regex (mc/schema [:fn {:error/message "not a regex"}
(fn check-regx [x]
(try
(and (string? x)
(. java.util.regex.Pattern (compile x java.util.regex.Pattern/CASE_INSENSITIVE)))
true
(catch Exception _
false)))]))
(def map->db-id-decoder
{:enter (fn [x]
(into []
(for [[k v] x]
(assoc v :db/id (cond (and (string? k) (re-find #"^\d+$" k))
(Long/parseLong k)
(keyword? k)
(name k)
:else
k)))))})
(defn many-entity [params & keys]
(mc/schema
[:vector (merge params {:decode/json map->db-id-decoder
:decode/arbitrary (fn [x]
(if (sequential? x)
x
[x]))})
(into [:map] keys)]))
(defn str->keyword [s]
(if (string? s)
@@ -97,65 +145,76 @@
(defn keyword->str [k]
(subs (str k) 1))
(defn validation-error [m & [data]]
(defn validation-error [m & {:as data}]
(throw+ (ex-info m (merge data {:type :validation}))))
(defn field-validation-error [m path & {:as data}]
(throw+ (ex-info m (merge data {:type :field-validation
:field-validation-errors [{:path path
:message [m]}]}))))
(defn form-validation-error [m & {:as data}]
(throw+ (ex-info m (merge data {:type :form-validation
:form-validation-errors [m]}))))
(def main-transformer
(mt2/transformer
parse-empty-as-nil
(mt2/key-transformer {:encode keyword->str :decode str->keyword})
mt2/string-transformer
mt2/json-transformer
(mt2/transformer {:name :arbitrary})))
(defn wrap-schema-decode [handler & {:keys [form-schema query-schema route-schema params-schema]}]
(fn [{:keys [form-params query-params params] :as request}]
(fn [{:keys [form-params query-params params] :as request}]
(let [request (try
(cond-> request
(and (:params request) params-schema)
(assoc :params
(mc/coerce
params-schema
(:params request)
(mt2/transformer
(mt2/key-transformer {:encode keyword->str :decode str->keyword})
mt2/string-transformer
mt2/json-transformer) ))
(cond-> request
(and (:params request) params-schema)
(assoc :params
(mc/coerce
params-schema
(:params request)
main-transformer))
(and (:route-params request) route-schema)
(assoc :route-params
(mc/coerce
route-schema
(:route-params request)
(mt2/transformer
(mt2/key-transformer {:encode keyword->str :decode str->keyword})
mt2/string-transformer
mt2/json-transformer) ))
(and (:route-params request) route-schema)
(assoc :route-params
(mc/coerce
route-schema
(:route-params request)
main-transformer))
(and form-schema form-params)
(assoc :form-params
(mc/coerce
form-schema
form-params
(mt2/transformer
(mt2/key-transformer {:encode keyword->str :decode str->keyword})
mt2/string-transformer
mt2/json-transformer) ))
(and form-schema form-params)
(assoc :form-params
(mc/coerce
form-schema
form-params
main-transformer))
(and query-schema query-params)
(assoc :query-params
(mc/coerce
query-schema
query-params
main-transformer)))
(catch Exception e
(alog/warn ::validation-error :error e)
(throw (ex-info (->> (-> e
(ex-data )
:data
:explain
(me/humanize {:errors (assoc me/default-errors
::mc/missing-key {:error/message {:en "required"}})}))
(map (fn [[k v]]
(str (if (keyword? k)
(name k)
k) ": " (str/join ", " v))))
(str/join ", "))
{:type :schema-validation
:decoded (:value (:data (ex-data e)))
:error (:data (ex-data e))}))))]
(handler request))))
(and query-schema query-params)
(assoc :parsed-query-params
(mc/coerce
query-schema
query-params
(mt2/transformer
(mt2/key-transformer {:encode name :decode keyword})
mt2/string-transformer
mt2/json-transformer) )))
(catch Exception e
(alog/warn ::validation-error :error e)
(validation-error (str/join ", "
(->> e
(ex-data )
:data
:explain
me/humanize
(map (fn [[k v]]
(str (if (keyword? k)
(name k)
k) ": " (str/join ", " v))
)))))))] (handler request))))
(defn ref->enum-schema [n]
(into [:enum {:decode/string #(keyword n %)}]
(for [{:db/keys [ident]} (all-schema)
@@ -170,16 +229,15 @@
:when (= n (namespace ident))]
[(name ident) (str/replace (str/capitalize (name ident)) "-" " ")])))
(def map->db-id-decoder
{:enter (fn [x]
(into []
(for [[k v] x]
(assoc v :db/id (cond (and (string? k) (re-find #"^\d+$" k))
(Long/parseLong k)
(keyword? k)
(name k)
:else
k)))))})
(defn ref->radio-options [n & {:keys [allow-nil?]}]
(into (if allow-nil?
[{:value nil :content ""}]
[])
(for [{:db/keys [ident]} (all-schema)
:when (= n (namespace ident))]
{:value (name ident) :content (str/replace (str/capitalize (name ident)) "-" " ")})))
#_(defn namespaceize-decoder [n]
{:exit (fn [m]
@@ -202,8 +260,48 @@
(catch [:type :validation] e
(alog/warn ::form-4xx :error e)
(html-response [:span.error-content.text-red-500 (:message &throw-context)]
:status 400))))
)
:status 400)))))
(defn assoc-errors-into-meta [entity errors]
(reduce
(fn add-error [entity {:keys [path message] :as se}]
(if (= (count path) 1)
(with-meta entity (assoc (meta entity) (last path) {:errors message}))
(update-in entity (butlast path)
(fn [terminal]
(with-meta terminal (assoc (meta terminal) (last path) {:errors message}))))))
entity
errors))
(defn wrap-form-4xx-2 [handler form-handler]
(fn [request]
(try+
(handler request)
(catch [:type :schema-validation] e
(let [humanized (-> e :error :explain (me/humanize {:errors (assoc me/default-errors
::mc/missing-key {:error/message {:en "required"}})}))
errors (map
(fn [e]
{:path (:in e)
:message (get-in humanized (:in e))})
(:errors (:explain (:error e))))]
(alog/warn ::form-4xx :errors errors)
(form-handler (assoc request
:last-form (assoc-errors-into-meta (:decoded e) errors)
:field-validation-errors errors)))
#_(html-response [:span.error-content.text-red-500 (:message &throw-context)]
:status 400))
(catch [:type :field-validation] e
(form-handler (assoc request
:last-form (assoc-errors-into-meta (:form e) (:field-validation-errors e))
:field-validation-errors (:field-validation-errors e))))
(catch [:type :form-validation] e
(form-handler (assoc request
:last-form (with-meta (:form e) {:errors (:form-validation-errors e)})
:form-validation-errors (:form-validation-errors e)))))))
(defn apply-middleware-to-all-handlers [key->handler f]
(->> key->handler
@@ -212,3 +310,14 @@
(assoc key-handler k (f v)))
key->handler)
))
(defn path->name2 [k & rest]
(let [k->n (fn [k]
(if (keyword? k)
(str (namespace k) "/" (name k))
k))]
(str (k->n k)
(str/join ""
(map (fn [k]
(str "[" (k->n k) "]"))
rest)))))