✨ Add minor improvements to common.schema ns

common/src/app/common/schema.cljc

@@ -21,6 +21,7 @@
    [cuerdas.core :as str]
    [malli.core :as m]
    [malli.dev.pretty :as mdp]
+   [malli.dev.virhe :as v]
    [malli.error :as me]
    [malli.generator :as mg]
    [malli.registry :as mr]
@@ -104,6 +105,10 @@
   [exp]
   (malli.error/error-value exp {:malli.error/mask-valid-values '...}))
 
+(defn optional-keys
+  [schema]
+  (mu/optional-keys schema default-options))
+
 (def default-transformer
   (let [default-decoder
         {:compile (fn [s _registry]
@@ -190,9 +195,10 @@
     (fn [v] (@vfn v))))
 
 (defn lazy-decoder
-  [s transformer]
+  ([s] (lazy-decoder s default-transformer))
+  ([s transformer]
    (let [vfn (delay (decoder (if (delay? s) (deref s) s) transformer))]
-    (fn [v] (@vfn v))))
+     (fn [v] (@vfn v)))))
 
 (defn humanize-explain
   [{:keys [schema errors value]} & {:keys [length level]}]
@@ -207,9 +213,29 @@
                                      :level (d/nilv level 8)
                                      :length (d/nilv length 12)})))))
 
+
+(defmethod v/-format ::schemaless-explain
+  [_ {:keys [schema] :as explanation} printer]
+  {:body [:group
+          (v/-block "Value" (v/-visit (me/error-value explanation printer) printer) printer) :break :break
+          (v/-block "Errors" (v/-visit (me/humanize (me/with-spell-checking explanation)) printer) printer) :break :break
+          (v/-block "Schema" (v/-visit schema printer) printer)]})
+
+
+(defmethod v/-format ::explain
+  [_ {:keys [schema] :as explanation} printer]
+  {:body [:group
+          (v/-block "Value" (v/-visit (me/error-value explanation printer) printer) printer) :break :break
+          (v/-block "Errors" (v/-visit (me/humanize (me/with-spell-checking explanation)) printer) printer) :break :break
+          (v/-block "Schema" (v/-visit schema printer) printer)]})
+
+
 (defn pretty-explain
-  [s d]
+  [explain & {:keys [variant message]
-  (mdp/explain (schema s) d))
+              :or {variant ::explain
+                   message "Validation Error"}}]
+  (let [explain (fn [] (me/with-error-messages explain))]
+    ((mdp/prettifier variant message explain default-options))))
 
 (defmacro ignoring
   [expr]
@@ -297,7 +323,7 @@
        (throw (ex-info hint options))))))
 
 (defn validate-fn
-  "Create a predefined validate function"
+  "Create a predefined validate function that raises an expception"
   [s]
   (let [schema (if (lazy-schema? s) s (define s))]
     (partial fast-validate! schema)))
@@ -317,6 +343,7 @@
              hint    (get options :hint "schema validation error")]
          (throw (ex-info hint options)))))))
 
+;; FIXME: revisit
 (defn conform!
   [schema value]
   (assert (lazy-schema? schema) "expected `schema` to satisfy ILazySchema protocol")
@@ -476,11 +503,14 @@
 
 (define! ::set
   {:type :set
+   :min 0
+   :max 1
    :compile
-   (fn [{:keys [coerce kind max min] :as props} _ _]
+   (fn [{:keys [coerce kind max min] :as props} children _]
      (let [xform (if coerce
                    (comp non-empty-strings-xf (map coerce))
                    non-empty-strings-xf)
+           kind  (or (last children) kind)
            pred  (cond
                    (fn? kind)  kind
                    (nil? kind) any?
@@ -509,7 +539,8 @@
                            (every? pred value))))
 
                   :else
-                  pred)]
+                  (fn [value]
+                    (every? pred value)))]
 
        {:pred pred
         :type-properties
@@ -525,6 +556,64 @@
                          (let [v (if (string? v) (str/split v #"[\s,]+") v)]
                            (into #{} xform v)))}}))})
 
+
+(define! ::vec
+  {:type :vector
+   :min 0
+   :max 1
+   :compile
+   (fn [{:keys [coerce kind max min] :as props} children _]
+     (let [xform (if coerce
+                   (comp non-empty-strings-xf (map coerce))
+                   non-empty-strings-xf)
+
+           kind  (or (last children) kind)
+           pred  (cond
+                   (fn? kind)  kind
+                   (nil? kind) any?
+                   :else       (validator kind))
+
+           pred (cond
+                  (and max min)
+                  (fn [value]
+                    (let [size (count value)]
+                      (and (set? value)
+                           (<= min size max)
+                           (every? pred value))))
+
+                  min
+                  (fn [value]
+                    (let [size (count value)]
+                      (and (set? value)
+                           (<= min size)
+                           (every? pred value))))
+
+                  max
+                  (fn [value]
+                    (let [size (count value)]
+                      (and (set? value)
+                           (<= size max)
+                           (every? pred value))))
+
+                  :else
+                  (fn [value]
+                    (every? pred value)))]
+
+       {:pred pred
+        :type-properties
+        {:title "set"
+         :description "Set of Strings"
+         :error/message "should be a set of strings"
+         :gen/gen (-> kind sg/generator sg/set)
+         ::oapi/type "array"
+         ::oapi/format "set"
+         ::oapi/items {:type "string"}
+         ::oapi/unique-items true
+         ::oapi/decode (fn [v]
+                         (let [v (if (string? v) (str/split v #"[\s,]+") v)]
+                           (into [] xform v)))}}))})
+
+
 (define! ::set-of-strings
   {:type ::set-of-strings
    :pred #(and (set? %) (every? string? %))

frontend/src/app/main/ui/auth/login.cljs

@@ -9,7 +9,6 @@
   (:require
    [app.common.logging :as log]
    [app.common.schema :as sm]
-   [app.common.spec :as us]
    [app.config :as cf]
    [app.main.data.messages :as msg]
    [app.main.data.users :as du]
@@ -25,7 +24,6 @@
    [app.util.keyboard :as k]
    [app.util.router :as rt]
    [beicon.v2.core :as rx]
-   [cljs.spec.alpha :as s]
    [rumext.v2 :as mf]))
 
 (def show-alt-login-buttons?
@@ -64,14 +62,6 @@
                      :else
                      (st/emit! (msg/error (tr "errors.generic"))))))))
 
-(s/def ::email ::us/email)
-(s/def ::password ::us/not-empty-string)
-(s/def ::invitation-token ::us/not-empty-string)
-
-(s/def ::login-form
-  (s/keys :req-un [::email ::password]
-          :opt-un [::invitation-token]))
-
 (def ^:private schema:login-form
   [:map {:title "LoginForm"}
    [:email [::sm/email {:error/code "errors.invalid-email"}]]
@@ -84,7 +74,6 @@
   (let [initial (mf/with-memo [params] params)
         error   (mf/use-state false)
         form    (fm/use-form :schema schema:login-form
-                             ;; :validators [handle-error-messages]
                              :initial initial)
 
         on-error