Merge pull request #838 from opqdonut/fix/always

fix: mx/defn + :malli/always + varargs

src/malli/experimental.cljc

@@ -50,20 +50,22 @@
         bodies (map (fn [{:keys [arglist prepost body]}] `(~arglist ~prepost ~@body)) parglists)
         validate? (or (:malli/always var-meta)
                       (:malli/always body-meta))
-        instr-fn-sym (gensym (str name "-instrumented"))]
-    `(let [~@(when validate?
-               [instr-fn-sym `(m/-instrument
-                               {:schema ~schema}
-                               (fn ~instr-fn-sym ~@bodies))])
-           defn# (c/defn
-                   ~name
-                   ~@(some-> doc vector)
-                   ~(assoc body-meta :raw-arglists (list 'quote raw-arglists), :schema schema)
-                   ~@(if validate?
-                       (for [{:keys [arglist prepost]} parglists]
-                         `(~arglist ~prepost (~instr-fn-sym ~@arglist)))
-                       bodies)
-                   ~@(when-not single (some->> arities val :meta vector)))]
+        enriched-meta (assoc body-meta :raw-arglists (list 'quote raw-arglists) :schema schema)]
+    `(let [defn# ~(if validate?
+                    `(def
+                       ~(with-meta name (merge var-meta
+                                               enriched-meta
+                                               {:arglists (list 'quote (map :arglist parglists))}))
+                       ~@(some-> doc vector)
+                       (m/-instrument
+                        {:schema ~schema}
+                        (fn ~(gensym (str name "-instrumented")) ~@bodies)))
+                    `(c/defn
+                       ~name
+                       ~@(some-> doc vector)
+                       ~enriched-meta
+                       ~@bodies
+                       ~@(when-not single (some->> arities val :meta vector))))]
        (m/=> ~name ~schema)
        defn#)))
 

test/malli/experimental/always_test.cljc

@@ -19,10 +19,26 @@
   ([x :- [:int {:min 2}]]
    x))
 
+(mx/defn ^:malli/always addition-varargs :- [:int {:min 0}]
+  [& xs :- [:cat [:int {:min 0}] [:* :int]]]
+  (apply + xs))
+
+(mx/defn ^:malli/always destructure :- [:map [:b :int]]
+  {:more "metadata"}
+  [[val, {:keys [a, b] :as m1}] :- [:tuple :int [:map [:a :string]]],
+   {c :foo :as m2} :- [:map [:foo :int]]]
+  {:val val
+   :a a
+   :b b
+   :m1 m1
+   :c c
+   :m2 m2})
+
 (defn always-assertions []
   (doseq [[f description] [[addition ":malli/always meta on var"]
                            [addition-2 ":malli/always meta inside defn"]
-                           [addition-multiarity "multiple arities"]]]
+                           [addition-multiarity "multiple arities"]
+                           [addition-varargs "varargs"]]]
     (testing description
       (is (= 3 (f 1 2))
           "valid input works")
@@ -43,7 +59,33 @@
            (try (addition-multiarity 1)
                 (catch #?(:clj Exception :cljs js/Error) e
                   (:type (ex-data e)))))
-        "invalid input throws")))
+        "invalid input throws"))
+  (testing "destructuring"
+    (is (= {:val 1 :a "foo" :b 3
+            :m1 {:a "foo" :b 3}
+            :c 4
+            :m2 {:foo 4 :bar 5}}
+           (destructure [1 {:a "foo" :b 3}]
+                        {:foo 4 :bar 5}))
+        "valid input works")
+    (is (= :malli.core/invalid-input
+             (try (destructure [1 {:a 2 :b 3}]
+                               {:foo 4 :bar 5})
+                  (catch #?(:clj Exception :cljs js/Error) e
+                    (:type (ex-data e)))))
+        "invalid input throws")
+    (is (= :malli.core/invalid-input
+           (try (destructure [1 {:a "foo" :b 3}]
+                             {:bar 5})
+                (catch #?(:clj Exception :cljs js/Error) e
+                  (:type (ex-data e)))))
+        "invalid input throws")
+    (is (= :malli.core/invalid-output
+           (try (destructure [1 {:a "foo" :b true}]
+                             {:foo 4 :bar 5})
+                (catch #?(:clj Exception :cljs js/Error) e
+                  (:type (ex-data e)))))
+        "invalid output throws")))
 
 (deftest always-test
   (testing "without malli.dev"
@@ -58,3 +100,21 @@
              (malli.dev/stop!))))
        (testing "after malli.dev/stop!"
          (always-assertions)))))
+
+(mx/defn destructure2 :- [:map [:b :int]]
+  {:more "metadata"}
+  [[val, {:keys [a, b] :as m1}] :- [:tuple :int [:map [:a :string]]],
+   {c :foo :as m2} :- [:map [:foo :int]]]
+  {:val val
+   :a a
+   :b b
+   :m1 m1
+   :c c
+   :m2 m2})
+
+#?(:clj
+   (deftest always-metadata-test
+     (let [clean #(dissoc % :name :line :malli/always)]
+       (is (= (clean (meta #'destructure2))
+              (clean (meta #'destructure)))
+           ":malli/always doesn't affect generated metadata"))))