monkeypatch shadow-cljs

.clj-kondo/config.edn

@@ -480,6 +480,7 @@
   metabase.upload.impl-test/with-upload-table!                                          clojure.core/let
   metabase.util/for-map                                                                 clojure.core/for
   metabase.util.files/with-open-path-to-resource                                        clojure.core/let
+  metabase.util.malli.defn/def                                                          schema.core/def
   metabase.util.malli.defn/defn                                                         schema.core/defn
   metabase.util.malli.defn/defn-                                                        schema.core/defn
   metabase.util.malli.fn/fn                                                             schema.core/fn

shadow-cljs.edn

@@ -13,7 +13,8 @@
   {:target     :npm-module
    :output-dir "target/cljs_release/"
    :dev        {:output-dir "target/cljs_dev/"
-                :compiler-options {:reader-features #{:cljs-dev}}}
+                :compiler-options {:reader-features #{:cljs-dev}}
+                :build-hooks [(metabase.util.shadow-build-hook/hook)]}
    :compiler-options {:reader-features #{:cljs-release}
                       :source-map      true}
    :closure-defines {goog.debug.LOGGING_ENABLED true}

src/metabase/util/currency.cljc

@@ -1,5 +1,7 @@
 (ns metabase.util.currency
-  "The list of currencies, and associated metadata, used by Metabase for number formatting.")
+  "The list of currencies, and associated metadata, used by Metabase for number formatting."
+  (:require
+   [metabase.util.malli :as mu]))
 
 (defn supports-symbol?
   "Currencies for which the Metabase frontend supports formatting with its symbol, rather than just
@@ -165,13 +167,13 @@
   "The currencies as a Clojure map."
   (into {} currency-list))
 
-(defn ^:export currency-symbol
+(mu/defn ^:export currency-symbol :- :string
   "Given a currency symbol, as a string or keyword, look it up in the currency
   map and return the symbol for it as a string."
-  [currency]
+  [currency :- :string]
   (some->> currency keyword currency-map :symbol))
 
-(def ^:export currency
+(mu/def ^:export currency :- [:map-of :keyword [:map [:symbol :string]]]
   "Returns the list of currencies supported by Metabase, with associated metadata.
   In Clojure, it is converted to a map for quick lookup of currency symbols during XLSX
   exports. In ClojureScript, it is kept as a 2D array to maintain the order of currencies."

src/metabase/util/malli.cljc

@@ -19,7 +19,7 @@
 #?(:clj
    (p/import-vars
     [mu.fn fn instrument-ns?]
-    [mu.defn defn defn-]))
+    [mu.defn defn defn- def]))
 
 (core/defn humanize-include-value
   "Pass into mu/humanize to include the value received in the error message."

src/metabase/util/malli/defn.clj

@@ -3,9 +3,11 @@
   (:require
    [clojure.core :as core]
    [clojure.string :as str]
+   [malli.core :as mc]
    [malli.destructure]
    [metabase.util :as u]
    [metabase.util.malli.fn :as mu.fn]
+   [metabase.util.malli.registry :as mr]
    [net.cgrand.macrovich :as macros]))
 
 (set! *warn-on-reflection* true)
@@ -59,6 +61,139 @@
           (when (not-empty doc)
             (str "\n\n  " doc))))))
 
+(core/defn- schema->jsdoc
+  "Convert a Malli schema to a JSDoc/TypeScript type string.
+  Returns nil for :any schemas or schemas that can't be converted.
+
+  `visited` is a set of schema references we've already seen to prevent infinite recursion."
+  ([schema]
+   (schema->jsdoc schema #{}))
+  ([schema visited]
+   (cond
+     (= schema :any) "*"
+
+     ;; Qualified keywords are registry references - try to resolve them
+     (and (keyword? schema) (namespace schema))
+     (when-not (visited schema)
+       (try
+         (let [resolved (mr/resolve-schema schema)]
+           (schema->jsdoc (mc/form resolved) (conj visited schema)))
+         (catch Exception _e
+           nil)))
+
+     (keyword? schema)
+     (case schema
+       :int     "number"
+       :string  "string"
+       :boolean "boolean"
+       :double  "number"
+       :float   "number"
+       :keyword "string"
+       :symbol  "string"
+       :uuid    "string"
+       :nil     "null"
+       nil)
+
+     ;; Handle predicate functions like int?, string?, etc.
+     (symbol? schema)
+     (let [schema-str (name schema)]
+       (when (str/ends-with? schema-str "?")
+         (case (subs schema-str 0 (dec (count schema-str)))
+           "int"     "number"
+           "number"  "number"
+           "string"  "string"
+           "boolean" "boolean"
+           "double"  "number"
+           "float"   "number"
+           "keyword" "string"
+           "symbol"  "string"
+           "uuid"    "string"
+           "nil"     "null"
+           nil)))
+
+     (vector? schema)
+     (case (first schema)
+       :map
+       (let [entries (rest schema)
+             ;; Map entries can be [k v] or [k options v] where options is a map
+             props (keep (fn [entry]
+                           (when (vector? entry)
+                             (let [[k maybe-opts maybe-v] entry
+                                   ;; If second element is a map, it's options
+                                   v (if (map? maybe-opts)
+                                       maybe-v
+                                       maybe-opts)
+                                   k-name (if (keyword? k)
+                                            (name k)
+                                            (str k))
+                                   v-type (schema->jsdoc v visited)]
+                               (when v-type
+                                 (str k-name ": " v-type)))))
+                         entries)]
+         (when (seq props)
+           (str "{" (str/join ", " props) "}")))
+
+       :map-of
+       (let [[_ left right] schema]
+         (str "Object.<" (schema->jsdoc left visited) "," (schema->jsdoc right visited) ">"))
+
+       :vector
+       (when-let [item-type (schema->jsdoc (second schema) visited)]
+         (str item-type "[]"))
+
+       :sequential
+       (when-let [item-type (schema->jsdoc (second schema) visited)]
+         (str item-type "[]"))
+
+       :set
+       (when-let [item-type (schema->jsdoc (second schema) visited)]
+         (str "Set<" item-type ">"))
+
+       :enum
+       (let [entries (drop (if (map? (second schema)) 2 1) schema)]
+         (str "(" (str/join " | " (map #(str "'" (subs (str %) 1) "'") entries)) ")"))
+
+       :or
+       (let [types (keep #(schema->jsdoc % visited) (rest schema))]
+         (when (seq types)
+           (str/join " | " types)))
+
+       :maybe
+       (when-let [inner (schema->jsdoc (second schema) visited)]
+         (str "?" inner))
+
+       nil)
+
+     :else nil)))
+
+(core/defn- *make-fn-jsdoc
+  "Schema is expected to be:
+
+  [:function [:=> [:cat :string] :string] [:=> [:cat :string :string] :string]]"
+  [fn-schema arglist]
+  (let [[[_cat & param-schemas] return-schema] (drop 2 fn-schema)
+
+        param-jsdoc  (->> (map (fn [param-name param-schema]
+                                 (when-let [jsdoc (schema->jsdoc param-schema)]
+                                   (str "@param {" jsdoc "} " param-name)))
+                               arglist param-schemas)
+                          (filterv identity))
+        return-jsdoc (when-let [jsdoc (schema->jsdoc return-schema)]
+                       (str "@return {" jsdoc "}"))]
+    (cond-> param-jsdoc
+      return-jsdoc (conj return-jsdoc))))
+
+(core/defn- make-jsdoc
+  "Generate JSDoc for editors to consume"
+  [parsed]
+  (let [arities   (-> parsed :values :arities)
+        args      (case (:key arities)
+                    :single   (-> arities :value :values :args)
+                    :multiple (-> arities :value :values :arities last :values :args))
+        arglist   (:arglist (malli.destructure/parse args))
+        fn-schema (mu.fn/fn-schema parsed {:target :target/metadata})]
+    (u/ignore-exceptions (*make-fn-jsdoc fn-schema arglist))))
+
 (defmacro defn
   "Implementation of [[metabase.util.malli/defn]]. Like [[schema.core/defn]], but for Malli.
 
@@ -92,7 +227,8 @@
         {attr-map :meta} (:values parsed)
         attr-map         (merge
                           {:arglists (list 'quote (deparameterized-arglists parsed))
-                           :schema   (mu.fn/fn-schema parsed {:target :target/metadata})}
+                           :schema   (mu.fn/fn-schema parsed {:target :target/metadata})
+                           :jsdoc    (make-jsdoc parsed)}
                           attr-map)
         docstring        (annotated-docstring parsed)
         instrument?      (mu.fn/instrument-ns? *ns*)]
@@ -113,3 +249,32 @@
   `(defn
      ~(with-meta fn-name (assoc (meta fn-name) :private true))
      ~@fn-tail))
+
+(defmacro def
+  "Implementation of [[metabase.util.malli/def]]. Like [[schema.core/def]], but for Malli.
+
+  Example macroexpansion:
+
+    (mu/def x :- :int 42)
+
+    ;; =>
+
+    (def ^{:schema :int :jsdoc ...} x 42)"
+  [var-name _:- schema doc value]
+  (let [attr-map {:schema   schema
+                  :jsdoc    (when-let [jsdoc (u/ignore-exceptions (schema->jsdoc schema))]
+                              [(format "@type {%s}" jsdoc)])}
+        instrument?      (mu.fn/instrument-ns? *ns*)]
+    (if-not instrument?
+      `(def ~(vary-meta var-name merge attr-map)
+         ~doc
+         ~value)
+      `(def ~(vary-meta var-name merge attr-map)
+         ~(macros/case
+            :clj  `(if (mr/validate ~schema ~value)
+                     ~value
+                     (throw (ex-info "Invalid value for schema"
+                                     {:schema  ~schema
+                                      :value   ~value
+                                      :explain (mr/explain ~schema ~value)})))
+            :cljs value)))))

src/metabase/util/shadow_build_hook.clj

@@ -0,0 +1,61 @@
+(ns metabase.util.shadow-build-hook
+  "Do not require this from a normal app, it's a shadow-cljs hook"
+  (:require
+   [cljs.compiler :as comp]
+   [cljs.env :as env]
+   [clojure.string :as str]
+   [shadow.build.output]))
+
+(defn js-module-src-append
+  "Replacement for https://github.com/thheller/shadow-cljs/blob/425740ca9a0096aeeae5d5134f3531cfce5baa6b/src/main/shadow/build/output.clj#L521"
+  [state {:keys [ns] :as src}]
+  (if-not ns
+    ;; none-cljs, export the shortest name always, some goog files have multiple provides
+    (str "\nmodule.exports = "
+         (->> (:provides src)
+              (map str)
+              (sort)
+              (map comp/munge)
+              (first))
+         ";\n")
+    ;; cljs ns, export vars.
+    ;; enumarable only if tagged with :export or :export-as
+    (->> (get-in state [:compiler-env :cljs.analyzer/namespaces ns :defs])
+         (vals)
+         (filter (fn [def]
+                   (let [{:keys [export export-as]} (:meta def)]
+                     (or export (string? export-as)))))
+         ;; FIXME: any potential for :line missing?
+         ;; if so should they be first or last?
+         (sort-by #(:line % 0))
+         (map (fn [def]
+                (let [{:keys [export-as doc jsdoc]}
+                      (:meta def)
+
+                      export-name
+                      (if (string? export-as)
+                        export-as
+
+                        (let [def-name (symbol (name (:name def)))]
+                          (if (= 'default def-name) ;; avoid munge to default$
+                            "default"
+                            (comp/munge def-name))))
+                      munged (comp/munge (:name def))]
+
+                  (str (when (or doc jsdoc)
+                         (binding [env/*compiler* (atom {})]
+                           (with-out-str (comp/emit-comment doc (some->> (seq jsdoc)
+                                                                     (into [(str "@callback " munged)]))))))
+                       "Object.defineProperty(module.exports, \"" export-name "\", { "
+                       "enumerable: true, "
+                       "\n/**\n * @returns {" munged "} \n **/\n"
+                       "get: function() { return " munged "; }"
+                       " });"))))
+         (str/join "\n"))))
+
+(alter-var-root #'shadow.build.output/js-module-src-append (fn [_] js-module-src-append))
+
+(defn hook
+  {:shadow.build/stage :compile-prepare}
+  [build-state & _args]
+  build-state)

test/metabase/util/malli/defn_test.clj

@@ -5,6 +5,7 @@
    [clojure.walk :as walk]
    [malli.core :as mc]
    [malli.experimental :as mx]
+   [metabase.lib.schema.metadata :as lib.schema.metadata]
    [metabase.test :as mt]
    [metabase.util.malli :as mu]
    [metabase.util.malli.defn :as mu.defn]
@@ -39,6 +40,51 @@
          "           [x :- :int y :- :int])\n"
          "  Return: :int")))
 
+(deftest ^:parallel make-jsdoc-test
+  (let [parse #(mc/parse mx/SchematizedParams %)]
+    (testing "single arity function with schemas"
+      (is (= ["@param {number} x"
+              "@return {*}"]
+             (#'mu.defn/make-jsdoc (parse '(bar [x :- :int] (str x)))))))
+
+    (testing "single arity function with map schema"
+      (is (= ["@param {{x: number, y: number}} x"
+              "@return {*}"]
+             (#'mu.defn/make-jsdoc (parse '(bar [x :- [:map [:x int?] [:y int?]]] (str x)))))))
+
+    (testing "malli registry"
+      (is (= ["@param {{source: ('source/card' | 'source/native' | 'source/previous-stage' | 'source/table-defaults' | 'source/aggregations' | 'source/joins' | 'source/expressions' | 'source/implicitly-joinable')}} column"          
+              "@return {*}"]
+             (#'mu.defn/make-jsdoc (parse '(process-column
+                                            [column :- [:map
+                                                        [:lib/source {:optional true} ::lib.schema.metadata/column.source]]]
+                                            column))))))
+
+    (testing "single arity function with return schema"
+      (is (= ["@param {number} x"
+              "@return {number}"]
+             (#'mu.defn/make-jsdoc (parse '(bar :- :int [x :- :int] (str x)))))))
+
+    (testing "single arity function with multiple params"
+      (is (= ["@param {number} x"
+              "@param {string} y"
+              "@return {*}"]
+             (#'mu.defn/make-jsdoc (parse '(bar [x :- :int y :- :string] (str x)))))))
+
+    (testing "single arity function without schemas"
+      (is (= ["@param {*} x"
+              "@return {*}"]
+             (#'mu.defn/make-jsdoc (parse '(bar [x] (str x)))))))
+
+    (testing "multi-arity function uses largest arity"
+      (is (= ["@param {number} x"
+              "@param {number} y"
+              "@return {number}"]
+             (#'mu.defn/make-jsdoc (parse '(bar
+                                            :- :int
+                                            ([x :- :int] (str x))
+                                            ([x :- :int y :- :int] (str x))))))))))
+
 (mu/defn bar [x :- [:map [:x int?] [:y int?]]] (str x))
 
 (mu/defn baz :- [:map [:x int?] [:y int?]] [] {:x "3"})