🚧 More work on data and forms validation.

frontend/src/uxbox/util/forms2.cljs

@@ -0,0 +1,145 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2015-2017 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.util.forms2
+  (:refer-clojure :exclude [uuid])
+  (:require
+   [beicon.core :as rx]
+   [cljs.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [lentes.core :as l]
+   [potok.core :as ptk]
+   [rumext.alpha :as mf]
+   [uxbox.util.dom :as dom]
+   [uxbox.util.i18n :refer [tr]]))
+
+;; --- Handlers Helpers
+
+(defn- impl-mutator
+  [v update-fn]
+  (specify v
+    IReset
+    (-reset! [_ new-value]
+      (update-fn new-value))
+
+    ISwap
+    (-swap!
+      ([self f] (update-fn f))
+      ([self f x] (update-fn #(f % x)))
+      ([self f x y] (update-fn #(f % x y)))
+      ([self f x y more] (update-fn #(apply f % x y more))))))
+
+(defn- translate-error-type
+  [name]
+  "errors.undefined-error")
+
+(defn- interpret-problem
+  [acc {:keys [path pred val via in] :as problem}]
+  ;; (prn "interpret-problem" problem)
+  (cond
+    (and (empty? path)
+         (list? pred)
+         (= (first (last pred)) 'cljs.core/contains?))
+    (let [path (conj path (last (last pred)))]
+      (assoc-in acc path {:name ::missing :type :builtin}))
+
+    (and (not (empty? path))
+         (not (empty? via)))
+    (assoc-in acc path {:name (last via) :type :builtin})
+
+    :else acc))
+
+(defn use-form
+  [spec initial]
+  (let [[state update-state] (mf/useState {:data (if (fn? initial) (initial) initial)
+                                           :errors {}
+                                           :touched {}})
+        clean-data (s/conform spec (:data state))
+        problems (when (= ::s/invalid clean-data)
+                   (::s/problems (s/explain-data spec (:data state))))
+
+
+        errors (merge (reduce interpret-problem {} problems)
+                      (:errors state))]
+    (-> (assoc state
+               :errors errors
+               :clean-data (when (not= clean-data ::s/invalid) clean-data)
+               :valid (and (empty? errors)
+                           (not= clean-data ::s/invalid)))
+        (impl-mutator update-state))))
+
+(defn on-input-change
+  [{:keys [data] :as form} field]
+  (fn [event]
+    (let [target (dom/get-target event)
+          value (dom/get-value target)]
+      (swap! form (fn [state]
+                    (-> state
+                        (assoc-in [:data field] value)
+                        (update :errors dissoc field)))))))
+
+(defn on-input-blur
+  [{:keys [touched] :as form} field]
+  (fn [event]
+    (let [target (dom/get-target event)]
+      (when-not (get touched field)
+        (swap! form assoc-in [:touched field] true)))))
+
+;; --- Helper Components
+
+(mf/defc field-error
+  [{:keys [form field type]
+    :or {only (constantly true)}
+    :as props}]
+  (let [touched? (get-in form [:touched field])
+        {:keys [message code] :as error} (get-in form [:errors field])]
+    (when (and touched? error
+               (cond
+                 (nil? type) true
+                 (keyword? type) (= (:type error) type)
+                 (ifn? type) (type (:type error))
+                 :else false))
+      (prn "field-error" error)
+      [:ul.form-errors
+       [:li {:key code} (tr message)]])))
+
+(defn error-class
+  [form field]
+  (when (and (get-in form [:errors field])
+             (get-in form [:touched field]))
+    "invalid"))
+
+;; --- Form Validation Api
+
+;; --- Form Specs and Conformers
+
+(def ^:private email-re
+  #"^[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+$")
+
+(def ^:private number-re
+  #"^[-+]?[0-9]*\.?[0-9]+$")
+
+(def ^:private color-re
+  #"^#[0-9A-Fa-f]{6}$")
+
+(s/def ::email
+  (s/and string? #(boolean (re-matches email-re %))))
+
+(s/def ::not-empty-string
+  (s/and string? #(not (str/empty? %))))
+
+(defn- parse-number
+  [v]
+  (cond
+    (re-matches number-re v) (js/parseFloat v)
+    (number? v) v
+    :else ::s/invalid))
+
+(s/def ::string-number
+  (s/conformer parse-number str))
+
+(s/def ::color
+  (s/and string? #(boolean (re-matches color-re %))))

frontend/src/uxbox/util/messages.cljs

@@ -25,11 +25,34 @@
 
 (def +animation-timeout+ 600)
 
-;; --- Message Event
+;; --- Main API
 
 (declare hide)
+(declare show)
 (declare show?)
 
+(defn error
+  [message & {:keys [timeout] :or {timeout 3000}}]
+  (show {:content message
+         :type :error
+         :timeout timeout}))
+
+(defn info
+  [message & {:keys [timeout] :or {timeout 3000}}]
+  (show {:content message
+         :type :info
+         :timeout timeout}))
+
+(defn dialog
+  [message & {:keys [on-accept on-cancel]}]
+  (show {:content message
+         :on-accept on-accept
+         :on-cancel on-cancel
+         :timeout js/Number.MAX_SAFE_INTEGER
+         :type :dialog}))
+
+;; --- Show Event
+
 (defn show
   [data]
   (reify
@@ -53,47 +76,19 @@
   [v]
   (= ::show (ptk/type v)))
 
-(defn error
-  [message & {:keys [timeout] :or {timeout 3000}}]
-  (show {:content message
-         :type :error
-         :timeout timeout}))
-
-(defn info
-  [message & {:keys [timeout] :or {timeout 3000}}]
-  (show {:content message
-         :type :info
-         :timeout timeout}))
-
-(defn dialog
-  [message & {:keys [on-accept on-cancel]}]
-  (show {:content message
-         :on-accept on-accept
-         :on-cancel on-cancel
-         :timeout js/Number.MAX_SAFE_INTEGER
-         :type :dialog}))
-
-;; --- Hide Message
+;; --- Hide Event
 
 (defn hide
   []
-  (let [canceled? (volatile! {})]
-    (reify
-      ptk/UpdateEvent
-      (update [_ state]
-        (update state :message
-                (fn [v]
-                  (if (nil? v)
-                    (do (vreset! canceled? true) nil)
-                    (assoc v :state :hide)))))
-
-      ptk/WatchEvent
-      (watch [_ state stream]
-        (if @canceled?
-          (rx/empty)
-          (->> (rx/of #(dissoc % :message))
-               (rx/delay +animation-timeout+)))))))
+  (reify
+    ptk/UpdateEvent
+    (update [_ state]
+      (update state :message assoc :state :hide))
 
+    ptk/WatchEvent
+    (watch [_ state stream]
+      (->> (rx/of #(dissoc % :message))
+           (rx/delay +animation-timeout+)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; UI Components
@@ -145,6 +140,7 @@
 
 (mf/defc messages-widget
   [{:keys [message] :as props}]
+  (prn "messages-widget" props)
   (case (:type message)
     :error (mf/element notification-box props)
     :info (mf/element notification-box props)

frontend/src/uxbox/util/spec.cljs

@@ -42,6 +42,12 @@
 (s/def ::uuid uuid?)
 (s/def ::email email?)
 (s/def ::color color?)
+(s/def ::string string?)
+(s/def ::number number?)
+(s/def ::positive pos?)
+(s/def ::inst inst?)
+(s/def ::keyword keyword?)
+(s/def ::fn fn?)
 
 ;; --- Public Api