adds mu/defn, which behaves like s/defn but for malli schemas (#27303)

* 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

@@ -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

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}

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 _)))))))

src/metabase/util/malli.clj

+(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))

test/metabase/util/malli_test.clj

+(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)))