wip

src/metabase/util/malli/registry.cljc

@@ -2,12 +2,19 @@
   (:refer-clojure :exclude [declare def])
   (:require
    #?@(:clj ([malli.experimental.time :as malli.time]
-             [net.cgrand.macrovich :as macros]))
+             [net.cgrand.macrovich :as macros]
+             [metabase.util.performance :as perf]))
+   [clojure.string :as str]
+   [clojure.walk :as walk]
    [malli.core :as mc]
    [malli.registry]
    [malli.util :as mut])
   #?(:cljs (:require-macros [metabase.util.malli.registry])))
 
+;;; for clj we use perf/prewalk
+(comment walk/prewalk)
+
+;;; weak refs?
 (defonce ^:private cache (atom {}))
 
 (defn- schema-cache-key
@@ -26,6 +33,58 @@
           x)
     x))
 
+;; (defn- schema-cache-key
+;;   "Make schemas that aren't `=` to identical ones e.g.
+
+;;     [:re #\"\\d{4}\"]
+
+;;   work correctly as cache keys instead of creating new entries every time the code is evaluated."
+;;   [x]
+;;   (->> x
+;;        (#?(:clj perf/prewalk :cljs walk/prewalk)
+;;         (fn [child]
+;;           (cond-> child
+;;             (mc/schema?) mc/form
+;;             (instance? #?(:clj java.util.regex.Pattern :cljs js/RegExp) child) str)))))
+
+(defn- fn-name [v]
+  (str/replace (str v) #"(.+)@.+" "$1"))
+
+(defn- schema-fingerprint [schema]
+  (#?(:clj perf/prewalk :cljs walk/prewalk)
+   (fn [v]
+     (cond
+       (or (nil? v)
+           (boolean? v)
+           (keyword? v)
+           (symbol? v)
+           (string? v)
+           (number? v)
+           (record? v)
+           (map? v)
+           (map-entry? v)
+           (vector? v)
+           (set? v)
+           (seq? v)
+           (char? v)
+           #?(:clj (class? v) :cljs nil)
+           (var? v))
+       v
+
+       (mc/schema? v)
+       (mc/form v)
+
+       (instance? #?(:clj java.util.regex.Pattern :cljs js/RegExp) v)
+       (str v)
+
+       (fn? v)
+       (fn-name v)
+
+       :else
+       (throw (ex-info "Unknown val" {:v v :type (type v) :class (#?(:clj class :cljs type) v)}))))
+
+   schema))
+
 (defn cached
   "Get a cached value for `k` + `schema`. Cache is cleared whenever a schema is (re)defined
   with [[metabase.util.malli.registry/def]]. If value doesn't exist, `value-thunk` is used to calculate (and cache)
@@ -34,11 +93,28 @@
   You generally shouldn't use this outside of this namespace unless you have a really good reason to do so! Make sure
   you used namespaced keys if you are using it elsewhere."
   [k schema value-thunk]
-  (let [schema-key (schema-cache-key schema)]
-    (or (get (get @cache k) schema-key)     ; get-in is terribly inefficient
-        (let [v (value-thunk)]
-          (swap! cache assoc-in [k schema-key] v)
-          v))))
+  (let [schema-key (schema-cache-key schema)
+        schema-fingerprint (schema-fingerprint schema-key)
+        c @cache
+        schema-key' (get-in c [:schema-fingerprint k schema-fingerprint])]
+    (if-let [cached-val (get (get c k) schema-key)]
+      cached-val
+      (let [v (value-thunk)]
+        (when schema-key'
+          (throw (ex-info "clashing schema" {:schema schema
+                                             :key schema-key
+                                             :existing-key schema-key'
+                                             :fingerprint schema-fingerprint
+                                             :class (#?(:clj class :cljs type) schema)
+                                             ;; :cache @cache
+                                             })))
+        ;; wip check for par tests
+        (swap! cache #(if (get-in % [k schema-key])
+                        %
+                        (-> %
+                            (assoc-in [k schema-key] v)
+                            (assoc-in [:schema-fingerprint k schema-fingerprint] schema-key))))
+        v))))
 
 (defn validator
   "Fetch a cached [[mc/validator]] for `schema`, creating one if needed. The cache is flushed whenever the registry