Merge pull request #3854 from penpot/niwinz-develop-yetti-update

✨ Update yetti and simplify internal worker module

common/src/app/common/exceptions.cljc

@@ -65,23 +65,22 @@
      (instance? RuntimeException v)))
 
 (defn explain
-  ([data] (explain data nil))
-  ([data opts]
-   (cond
-     ;; NOTE: a special case for spec validation errors on integrant
-     (and (= (:reason data) :integrant.core/build-failed-spec)
-          (contains? data :explain))
-     (explain (:explain data) opts)
+  [data & {:as opts}]
+  (cond
+    ;; NOTE: a special case for spec validation errors on integrant
+    (and (= (:reason data) :integrant.core/build-failed-spec)
+         (contains? data :explain))
+    (explain (:explain data) opts)
 
-     (and (contains? data ::s/problems)
-          (contains? data ::s/value)
-          (contains? data ::s/spec))
-     (binding [s/*explain-out* expound/printer]
-       (with-out-str
-         (s/explain-out (update data ::s/problems #(take (:length opts 10) %)))))
+    (and (contains? data ::s/problems)
+         (contains? data ::s/value)
+         (contains? data ::s/spec))
+    (binding [s/*explain-out* expound/printer]
+      (with-out-str
+        (s/explain-out (update data ::s/problems #(take (:length opts 10) %)))))
 
-     (contains? data ::sm/explain)
-     (sm/humanize-data (::sm/explain data) opts))))
+    (contains? data ::sm/explain)
+    (sm/humanize-explain (::sm/explain data) opts)))
 
 #?(:clj
 (defn format-throwable
@@ -92,8 +91,8 @@
                             data? true
                             explain? true
                             chain? true
-                            data-length 10
-                            data-level 4}}]
+                            data-length 8
+                            data-level 5}}]
 
   (letfn [(print-trace-element [^StackTraceElement e]
             (let [class (.getClassName e)
@@ -115,7 +114,7 @@
           (print-data [data]
             (when (seq data)
               (print "    dt: ")
-              (let [[line & lines] (str/lines (pp/pprint-str data :level data-level :length data-length ))]
+              (let [[line & lines] (str/lines (pp/pprint-str data :level data-level :length data-length))]
                 (print line)
                 (newline)
                 (doseq [line lines]

common/src/app/common/files/builder.cljc

@@ -50,7 +50,7 @@
 
      (when-not valid?
        (let [explain (sm/explain ::ch/change change)]
-         (pp/pprint (sm/humanize-data explain))
+         (pp/pprint (sm/humanize-explain explain))
          (when fail-on-spec?
            (ex/raise :type :assertion
                      :code :data-validation

common/src/app/common/pprint.cljc

@@ -7,16 +7,16 @@
 (ns app.common.pprint
   (:refer-clojure :exclude [prn])
   (:require
-   [fipp.edn :as fpp]))
-
-(defn pprint-str
-  [expr & {:keys [width level length]
-           :or {width 110 level 8 length 25}}]
-  (binding [*print-level* level
-            *print-length* length]
-    (with-out-str
-      (fpp/pprint expr {:width width}))))
+   [me.flowthing.pp :as pp]))
 
 (defn pprint
+  [expr & {:keys [width level length]
+           :or {width 120 level 8 length 25}}]
+  (binding [*print-level* level
+            *print-length* length]
+    (pp/pprint expr {:max-width width})))
+
+(defn pprint-str
   [expr & {:as opts}]
-  (println (pprint-str expr opts)))
+  (with-out-str
+    (pprint expr opts)))

common/src/app/common/schema.cljc

@@ -16,7 +16,7 @@
    [app.common.schema.registry :as sr]
    [app.common.uri :as u]
    [app.common.uuid :as uuid]
-   [clojure.test.check.generators :as tgen]
+   [clojure.core :as c]
    [cuerdas.core :as str]
    [malli.core :as m]
    [malli.dev.pretty :as mdp]
@@ -26,7 +26,12 @@
    [malli.transform :as mt]
    [malli.util :as mu]))
 
-(defprotocol ISchemaOps
+(defprotocol ILazySchema
+  (-get-schema [_])
+  (-get-validator [_])
+  (-get-explainer [_])
+  (-get-decoder [_])
+  (-get-encoder [_])
   (-validate [_ o])
   (-explain [_ o])
   (-decode [_ o]))
@@ -34,21 +39,31 @@
 (def default-options
   {:registry sr/default-registry})
 
-(defn explain
-  [s value]
-  (m/explain s value default-options))
-
 (defn schema?
   [o]
   (m/schema? o))
 
+(defn lazy-schema?
+  [s]
+  (satisfies? ILazySchema s))
+
 (defn schema
   [s]
-  (m/schema s default-options))
+  (if (lazy-schema? s)
+    (-get-schema s)
+    (m/schema s default-options)))
 
 (defn validate
   [s value]
-  (m/validate s value default-options))
+  (if (lazy-schema? s)
+    (-validate s value)
+    (m/validate s value default-options)))
+
+(defn explain
+  [s value]
+  (if (lazy-schema? s)
+    (-explain s value)
+    (m/explain s value default-options)))
 
 (defn humanize
   [exp]
@@ -113,11 +128,15 @@
 
 (defn validator
   [s]
-  (-> s schema m/validator))
+  (if (lazy-schema? s)
+    (-get-validator s)
+    (-> s schema m/validator)))
 
 (defn explainer
   [s]
-  (-> s schema m/explainer))
+  (if (lazy-schema? s)
+    (-get-explainer s)
+    (-> s schema m/explainer)))
 
 (defn encode
   ([s val transformer]
@@ -131,9 +150,23 @@
   ([s val options transformer]
    (m/decode s val options transformer)))
 
-(defn decoder
+(defn encoder
+  ([s]
+   (if (lazy-schema? s)
+     (-get-decoder s)
+     (encoder s default-options default-transformer)))
   ([s transformer]
-   (m/decoder s  default-options transformer))
+   (m/encoder s default-options transformer))
+  ([s options transformer]
+   (m/encoder s options transformer)))
+
+(defn decoder
+  ([s]
+   (if (lazy-schema? s)
+     (-get-decoder s)
+     (decoder s default-options default-transformer)))
+  ([s transformer]
+   (m/decoder s default-options transformer))
   ([s options transformer]
    (m/decoder s options transformer)))
 
@@ -152,19 +185,18 @@
   (let [vfn (delay (decoder (if (delay? s) (deref s) s) transformer))]
     (fn [v] (@vfn v))))
 
-(defn humanize-data
+(defn humanize-explain
   [{:keys [schema errors value]} & {:keys [length level]}]
   (let [errors (mapv #(update % :schema form) errors)]
     (with-out-str
       (println "Schema: ")
-      (println (pp/pprint-str (form schema) {:level (d/nilv level 10)
-                                             :length (d/nilv length 10)}))
+      (println (pp/pprint-str (form schema) {:width 100 :level 15 :length 20}))
       (println "Errors:")
-      (println (pp/pprint-str errors {:level (d/nilv level 10)
-                                      :length (d/nilv length 10)}))
+      (println (pp/pprint-str errors {:width 100 :level 15 :length 20}))
       (println "Value:")
-      (println (pp/pprint-str value {:level (d/nilv level 5)
-                                     :length (d/nilv length 10)})))))
+      (println (pp/pprint-str value {:width 160
+                                     :level (d/nilv level 8)
+                                     :length (d/nilv length 12)})))))
 
 (defn pretty-explain
   [s d]
@@ -202,10 +234,8 @@
   ([s] (lookup sr/default-registry s))
   ([registry s] (schema (mr/schema registry s))))
 
-(declare define)
-
 (defn fast-check!
-  "A fast path for checking process, assumes the ISchemaOps protocol
+  "A fast path for checking process, assumes the ILazySchema protocol
   implemented on the provided `s` schema. Sould not be used directly."
   [s value]
   (when-not ^boolean (-validate s value)
@@ -217,10 +247,12 @@
                             ::explain explain}))))
   true)
 
+(declare define)
+
 (defn check-fn
   "Create a predefined check function"
   [s]
-  (let [schema (if (satisfies? ISchemaOps s) s (define s))]
+  (let [schema (if (lazy-schema? s) s (define s))]
     (partial fast-check! schema)))
 
 (defn check!
@@ -228,7 +260,7 @@
   schema over provided data. Raises an assertion exception, should be
   used together with `dm/assert!` or `dm/verify!`."
   [s value]
-  (if (satisfies? ISchemaOps s)
+  (if (lazy-schema? s)
     (fast-check! s value)
     (do
       (when-not ^boolean (m/validate s value default-options)
@@ -242,7 +274,7 @@
 
 
 (defn fast-validate!
-  "A fast path for validation process, assumes the ISchemaOps protocol
+  "A fast path for validation process, assumes the ILazySchema protocol
   implemented on the provided `s` schema. Sould not be used directly."
   ([s value] (fast-validate! s value nil))
   ([s value options]
@@ -258,14 +290,14 @@
 (defn validate-fn
   "Create a predefined validate function"
   [s]
-  (let [schema (if (satisfies? ISchemaOps s) s (define s))]
+  (let [schema (if (lazy-schema? s) s (define s))]
     (partial fast-validate! schema)))
 
 (defn validate!
   "A generic validation function for predefined schemas."
   ([s value] (validate! s value nil))
   ([s value options]
-   (if (satisfies? ISchemaOps s)
+   (if (lazy-schema? s)
      (fast-validate! s value options)
      (when-not ^boolean (m/validate s value default-options)
        (let [explain (explain s value)
@@ -278,7 +310,7 @@
 
 (defn conform!
   [schema value]
-  (assert (satisfies? ISchemaOps schema) "expected `schema` to satisfy ISchemaOps protocol")
+  (assert (lazy-schema? schema) "expected `schema` to satisfy ILazySchema protocol")
   (let [params (-decode schema value)]
     (fast-validate! schema params nil)
     params))
@@ -296,11 +328,16 @@
   nil)
 
 (defn define
-  [s]
-  (let [schema    (delay (schema s))
-        validator (delay (validator @schema))
-        explainer (delay (explainer @schema))
-        decoder   (delay (decoder @schema default-transformer))]
+  "Create ans instance of ILazySchema"
+  [s & {:keys [transformer] :as options}]
+  (let [schema      (delay (schema s))
+        validator   (delay (m/validator @schema))
+        explainer   (delay (m/explainer @schema))
+
+        options     (c/merge default-options (dissoc options :transformer))
+        transformer (or transformer default-transformer)
+        decoder     (delay (m/decoder @schema options transformer))
+        encoder     (delay (m/encoder @schema options transformer))]
 
     (reify
       m/AST
@@ -342,7 +379,17 @@
       (-form [_]
         (m/-form @schema))
 
-      ISchemaOps
+      ILazySchema
+      (-get-schema [_]
+        @schema)
+      (-get-validator [_]
+        @validator)
+      (-get-explainer [_]
+        @explainer)
+      (-get-encoder [_]
+        @encoder)
+      (-get-decoder [_]
+        @decoder)
       (-validate [_ o]
         (@validator o))
       (-explain [_ o]
@@ -350,18 +397,6 @@
       (-decode [_ o]
         (@decoder o)))))
 
-;; --- GENERATORS
-
-;; FIXME: replace with sg/subseq
-(defn gen-set-from-choices
-  [choices]
-  (->> tgen/nat
-       (tgen/fmap (fn [i]
-                    (into #{}
-                          (map (fn [_] (rand-nth choices)))
-                          (range i))))))
-
-
 ;; --- BUILTIN SCHEMAS
 
 (define! :merge (mu/-merge))