From 7700751a32b53cba99d6cac3fa605c5ee9963790 Mon Sep 17 00:00:00 2001
From: Bryan Maass <bryan.maass@gmail.com>
Date: Thu, 29 Dec 2022 12:30:22 -0700
Subject: [PATCH] adds mu/defn, which behaves like s/defn but for malli schemas
(#27303)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
* adds mu/defn, which behaves like s/defn but for malli schemas
- includes link to malli.io with your schema and type.🔗
- making room for some namespaces
* require and use malli.destructure in mu/defn
* fix require alias
* clean ns
* fix linter errror
* fix linter error again
---
.clj-kondo/config.edn | 7 ++
.../mongo/test/metabase/driver/mongo_test.clj | 4 +-
.../mongo/test/metabase/test/data/mongo.clj | 4 +-
src/metabase/util/malli.clj | 74 +++++++++++++++++++
test/metabase/util/malli_test.clj | 25 +++++++
5 files changed, 110 insertions(+), 4 deletions(-)
create mode 100644 src/metabase/util/malli.clj
create mode 100644 test/metabase/util/malli_test.clj
diff --git a/.clj-kondo/config.edn b/.clj-kondo/config.edn
index 3fbc23c70f2..b93eedf16d9 100644
--- a/.clj-kondo/config.edn
+++ b/.clj-kondo/config.edn
@@ -119,6 +119,10 @@
honeysql.helpers hh
honeysql.types htypes
java-time t
+ malli.core mc
+ malli.experimental mx
+ malli.transform mtx
+ medley.core m
metabase-enterprise.audit-app.pages.common common
metabase-enterprise.sandbox.api.table table
metabase.analytics.stats stats
@@ -333,6 +337,7 @@
metabase.util.files u.files
metabase.util.i18n i18n
metabase.util.i18n.impl i18n.impl
+ metabase.util.malli mu
metabase.util.password u.password
metabase.util.schema su
metabase.util.ui-logic ui-logic
@@ -340,6 +345,7 @@
metabuild-common.core u
metabuild-common.output out
metabuild-common.shell shell
+ monger.collection mcoll
ring.mock.request ring.mock
ring.util.codec codec
ring.util.response response
@@ -397,6 +403,7 @@
metabase.test/with-temp-file clojure.core/let
metabase.test/with-user-in-groups clojure.core/let
metabase.util.files/with-open-path-to-resource clojure.core/let
+ metabase.util.malli/defn schema.core/defn
metabase.util.ssh/with-ssh-tunnel clojure.core/let
monger.operators/defoperator clojure.core/def
potemkin.types/defprotocol+ clojure.core/defprotocol
diff --git a/modules/drivers/mongo/test/metabase/driver/mongo_test.clj b/modules/drivers/mongo/test/metabase/driver/mongo_test.clj
index a742f096404..38362514ba2 100644
--- a/modules/drivers/mongo/test/metabase/driver/mongo_test.clj
+++ b/modules/drivers/mongo/test/metabase/driver/mongo_test.clj
@@ -19,7 +19,7 @@
[metabase.test :as mt]
[metabase.test.data.interface :as tx]
[metabase.test.data.mongo :as tdm]
- [monger.collection :as mc]
+ [monger.collection :as mcoll]
[taoensso.nippy :as nippy]
[toucan.db :as db])
(:import org.bson.types.ObjectId))
@@ -441,7 +441,7 @@
(doseq [[i row] (map-indexed vector row-maps)
:let [row (assoc row :_id (inc i))]]
(try
- (mc/insert conn collection-name row)
+ (mcoll/insert conn collection-name row)
(catch Throwable e
(throw (ex-info (format "Error inserting row: %s" (ex-message e))
{:database database-name, :collection collection-name, :details details, :row row}
diff --git a/modules/drivers/mongo/test/metabase/test/data/mongo.clj b/modules/drivers/mongo/test/metabase/test/data/mongo.clj
index 13e37f0e7d2..3af27ceae82 100644
--- a/modules/drivers/mongo/test/metabase/test/data/mongo.clj
+++ b/modules/drivers/mongo/test/metabase/test/data/mongo.clj
@@ -6,7 +6,7 @@
[metabase.driver.ddl.interface :as ddl.i]
[metabase.driver.mongo.util :refer [with-mongo-connection]]
[metabase.test.data.interface :as tx]
- [monger.collection :as mc]
+ [monger.collection :as mcoll]
[monger.core :as mg])
(:import com.fasterxml.jackson.core.JsonGenerator))
@@ -62,7 +62,7 @@
(doseq [[i row] (map-indexed vector rows)]
(try
;; Insert each row
- (mc/insert mongo-db (name table-name) (into {:_id (inc i)}
+ (mcoll/insert mongo-db (name table-name) (into {:_id (inc i)}
(zipmap field-names row)))
;; If row already exists then nothing to do
(catch com.mongodb.MongoException _)))))))
diff --git a/src/metabase/util/malli.clj b/src/metabase/util/malli.clj
new file mode 100644
index 00000000000..033f5e82cb0
--- /dev/null
+++ b/src/metabase/util/malli.clj
@@ -0,0 +1,74 @@
+(ns metabase.util.malli
+ (:refer-clojure :exclude [defn])
+ (:require
+ [clojure.core :as core]
+ [malli.core :as mc]
+ [malli.destructure]
+ [malli.error :as me]
+ [malli.experimental :as mx]
+ [malli.generator :as mg]
+ [malli.instrument :as minst]
+ [metabase.util :as u]
+ [ring.util.codec :as codec]))
+
+(core/defn- ->malli-io-link
+ ([schema]
+ (->malli-io-link schema (try (mg/generate schema {:seed 1 :size 1})
+ ;; not all schemas can generate values
+ (catch Exception _ ::none))))
+ ([schema value]
+ (let [url-schema (codec/url-encode (u/pprint-to-str (mc/form schema)))
+ url-value (if (= ::none value)
+ ""
+ (codec/url-encode (u/pprint-to-str value)))]
+ (str "https://malli.io?schema=" url-schema "&value=" url-value))))
+
+(core/defn- explain-fn-fail!
+ "Used as reporting function to minst/instrument!"
+ [type data]
+ (let [{:keys [input args output value]} data]
+ (throw (ex-info
+ (str type " " (pr-str data))
+ (merge {:type type :data data}
+ (when data
+ {:link (cond input (->malli-io-link input args)
+ output (->malli-io-link output value))
+ :humanized
+ (cond input (me/humanize (mc/explain input args))
+ output (me/humanize (mc/explain output value)))}))))))
+
+;; since a reference to the private var is used in the macro, this will trip the eastwood :unused-private-vars linter,
+;; so just harmlessly "use" the var here.
+explain-fn-fail!
+
+(core/defn- -defn [schema args]
+ (let [{:keys [name return doc meta arities] :as parsed} (mc/parse schema args)
+ _ (when (= ::mc/invalid parsed) (mc/-fail! ::parse-error {:schema schema, :args args}))
+ parse (fn [{:keys [args] :as parsed}] (merge (malli.destructure/parse args) parsed))
+ ->schema (fn [{:keys [schema]}] [:=> schema (:schema return :any)])
+ single (= :single (key arities))
+ parglists (if single
+ (->> arities val parse vector)
+ (->> arities val :arities (map parse)))
+ raw-arglists (map :raw-arglist parglists)
+ schema (as-> (map ->schema parglists) $ (if single (first $) (into [:function] $)))
+ id (str (gensym "id"))]
+ `(let [defn# (core/defn
+ ~name
+ ~@(some-> doc vector)
+ ~(assoc meta
+ :raw-arglists (list 'quote raw-arglists)
+ :schema schema
+ :validate! id)
+ ~@(map (fn [{:keys [arglist prepost body]}] `(~arglist ~prepost ~@body)) parglists)
+ ~@(when-not single (some->> arities val :meta vector)))]
+ (mc/=> ~name ~schema)
+ (minst/instrument! {:filters [(minst/-filter-var #(-> % meta :validate! (= ~id)))]
+ :report #'explain-fn-fail!})
+ defn#)))
+
+(defmacro defn
+ "Like s/defn, but for malli. Will always validate input and output without the need for calls to instrumentation (they are emitted automatically).
+ Calls to minst/unstrument! can remove this, so use a filter that avoids :validate! if you use that."
+ [& args]
+ (-defn mx/SchematizedParams args))
diff --git a/test/metabase/util/malli_test.clj b/test/metabase/util/malli_test.clj
new file mode 100644
index 00000000000..fe67184e3ad
--- /dev/null
+++ b/test/metabase/util/malli_test.clj
@@ -0,0 +1,25 @@
+(ns metabase.util.malli-test
+ (:require
+ [clojure.test :refer [deftest is testing]]
+ [metabase.util.malli :as mu]))
+
+(deftest mu-defn-test
+ (testing "invalid input"
+ (mu/defn bar [x :- [:map [:x int?] [:y int?]]] (str x))
+ (is (= [{:x ["missing required key"]
+ :y ["missing required key"]}]
+ (:humanized
+ (try (bar {})
+ (catch Exception e (ex-data e)))))
+ "when we pass bar an invalid shape um/defn throws")
+ (ns-unmap *ns* 'bar))
+
+ (testing "invalid output"
+ (mu/defn baz :- [:map [:x int?] [:y int?]] [] {:x "3"})
+ (is (= {:x ["should be an int"]
+ :y ["missing required key"]}
+ (:humanized
+ (try (baz)
+ (catch Exception e (ex-data e)))))
+ "when baz returns an invalid form um/defn throws")
+ (ns-unmap *ns* 'baz)))
--
GitLab