feat: use a custom Tagged record instead of MapEntry in parse output

Using a MapEntry was confusing users, because it printed like a
vector, but you couldn't give a vector to unparse.

The current method of using MapEntry was broken for weird schemas:

```
(def schema
  [:or
   [:tuple :string :keyword]
   [:orn ["any" :keyword]]])

(->> (m/parse schema :any) (m/unparse schema))
; => ["any" :any]
; should've been :any
```

Changes the parse behaviour for (at least) :orn, :altn and :multi

Some place (like the entry parsers) used miu/-tagged to generate
MapEntry values. These use sites now use the new miu/-entry. This
keeps the surface area of this change a lot smaller since we don't
need to touch all the map entry logic.

fixes #1123
replaces #1140

Author: opqdonut

src/malli/core.cljc

@@ -385,7 +385,7 @@
 ;;
 
 (defn -simple-entry-parser [keyset children forms]
-  (let [entries (map (fn [[k p s]] (miu/-tagged k (-val-schema s p))) children)]
+  (let [entries (map (fn [[k p s]] (miu/-entry k (-val-schema s p))) children)]
     (reify EntryParser
       (-entry-keyset [_] keyset)
       (-entry-children [_] children)
@@ -606,7 +606,7 @@
     (reify EntryParser
       (-entry-keyset [_] keyset)
       (-entry-children [_] @children)
-      (-entry-entries [_] (-vmap (fn [[k p s]] (miu/-tagged k (-val-schema s p))) @children))
+      (-entry-entries [_] (-vmap (fn [[k p s]] (miu/-entry k (-val-schema s p))) @children))
       (-entry-forms [_] (->> @children (-vmap (fn [[k p v]] (if p [k p (-form v)] [k (-form v)]))))))))
 
 (defn -from-entry-ast [parent ast options]
@@ -872,8 +872,8 @@
             (let [unparsers (into {} (map (fn [[k _ c]] [k (-unparser c)])) (-children this))]
               (fn [x]
                 (if (miu/-tagged? x)
-                  (if-some [unparse (get unparsers (key x))]
-                    (unparse (val x))
+                  (if-some [unparse (get unparsers (:key x))]
+                    (unparse (:value x))
                     ::invalid)
                   ::invalid))))
           (-transformer [this transformer method options]
@@ -1650,7 +1650,7 @@
                (fn [x] (if-some [parser (find (dispatch x))] (parser x) ::invalid))))
            (-unparser [_]
              (let [unparsers (reduce-kv (fn [acc k s] (assoc acc k (-unparser s))) {} @dispatch-map)]
-               (fn [x] (if (miu/-tagged? x) (if-some [f (unparsers (key x))] (f (val x)) ::invalid) ::invalid))))
+               (fn [x] (if (miu/-tagged? x) (if-some [f (unparsers (:key x))] (f (:value x)) ::invalid) ::invalid))))
            (-transformer [this transformer method options]
             ;; FIXME: Probably should not use `dispatch`
             ;; Can't use `dispatch` as `x` might not be valid before it has been unparsed:

src/malli/destructure.cljc

@@ -96,7 +96,7 @@
                                      (cond->> :always (conj [:*]) (not rest) (conj [:schema])))]]
       schema)))
 
-(defn -transform [{[k v] :arg schema :schema :as all} options rest]
+(defn -transform [{{k :key v :value} :arg schema :schema :as all} options rest]
   (cond (and schema rest) (let [s (-transform all options false)] (if (-any? s) schema s))
         schema schema
         (= :vec k) (-vector v options)

src/malli/experimental.cljc

@@ -41,8 +41,8 @@
         _ (when (= ::m/invalid parsed) (m/-fail! ::parse-error {:schema schema, :args args}))
         parse (fn [{:keys [args] :as parsed}] (merge (md/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)))
+        single (= :single (:key arities))
+        parglists (if single (->> arities :value parse vector) (->> arities :value :arities (map parse)))
         raw-arglists (map :raw-arglist parglists)
         schema (as-> (map ->schema parglists) $ (if single (first $) (into [:function] $)))
         bodies (map (fn [{:keys [arglist prepost body]}] `(~arglist ~prepost ~@body)) parglists)
@@ -60,7 +60,7 @@
                        ~@(some-> doc vector)
                        ~enriched-meta
                        ~@bodies
-                       ~@(when-not single (some->> arities val :meta vector))))]
+                       ~@(when-not single (some->> arities :value :meta vector))))]
        (m/=> ~name ~schema)
        defn#)))
 

src/malli/impl/regex.cljc

@@ -256,8 +256,8 @@
   (let [unparsers (into {} unparsers)]
     (fn [x]
       (if (miu/-tagged? x)
-        (if-some [kv (find unparsers (key x))]
-          ((val kv) (val x))
+        (if-some [kv (find unparsers (:key x))]
+          ((val kv) (:value x))
           :malli.core/invalid)
         :malli.core/invalid))))
 

src/malli/impl/util.cljc

@@ -5,8 +5,12 @@
 
 (def ^:const +max-size+ #?(:clj Long/MAX_VALUE, :cljs (.-MAX_VALUE js/Number)))
 
-(defn -tagged [k v] #?(:clj (MapEntry. k v), :cljs (MapEntry. k v nil)))
-(defn -tagged? [v] (instance? MapEntry v))
+(defn -entry [k v] #?(:clj (MapEntry. k v), :cljs (MapEntry. k v nil)))
+
+(defrecord Tagged [key value])
+
+(defn -tagged [key value] (->Tagged key value))
+(defn -tagged? [x] (instance? Tagged x))
 
 (defn -invalid? [x] #?(:clj (identical? x :malli.core/invalid), :cljs (keyword-identical? x :malli.core/invalid)))
 (defn -map-valid [f v] (if (-invalid? v) v (f v)))

test/malli/core_test.cljc

@@ -257,6 +257,7 @@
       (is (= (miu/-tagged :pos 1) (m/parse schema* 1)))
       (is (= ::m/invalid (m/parse schema* 0)))
       (is (= 1 (m/unparse schema* (miu/-tagged :pos 1))))
+      (is (= ::m/invalid (m/unparse schema* [:pos 1])))
       (is (= ::m/invalid (m/unparse schema* (miu/-tagged :pos 0))))
 
       (doseq [schema [schema schema*]]
@@ -1169,8 +1170,11 @@
       (is (= ::m/invalid (m/parse schema invalid5)))
       (is (= ::m/invalid (m/parse schema invalid6)))
       (is (= valid1 (m/unparse schema (m/parse schema valid1))))
+      (is (= valid1 (m/unparse schema (miu/-tagged :sized valid1))))
       (is (= valid2 (m/unparse schema (m/parse schema valid2))))
+      (is (= valid2 (m/unparse schema (miu/-tagged :human valid2))))
       (is (= valid3 (m/unparse schema (m/parse schema valid3))))
+      (is (= valid3 (m/unparse schema (miu/-tagged :sized valid3))))
       (is (= ::m/invalid (m/unparse schema invalid1)))
       (is (= ::m/invalid (m/unparse schema invalid2)))
       (is (= ::m/invalid (m/unparse schema invalid3)))
@@ -3206,10 +3210,10 @@
                     ["name" 'str]
                     [::m/default [:map-of 'str 'str]]]
             valid {:id 1, "name" "tommi", "kikka" "kukka", "abba" "jabba"}]
-        (is (= {:id [::int 1],
-                "name" [::str "tommi"]
-                [::str "kikka"] [::str "kukka"]
-                [::str "abba"] [::str "jabba"]}
+        (is (= {:id (miu/-tagged ::int 1)
+                "name" (miu/-tagged ::str "tommi")
+                (miu/-tagged ::str "kikka") (miu/-tagged ::str "kukka")
+                (miu/-tagged ::str "abba") (miu/-tagged ::str "jabba")}
                (m/parse schema valid)))
         (is (= valid (->> valid (m/parse schema) (m/unparse schema))))
         (is (= ::m/invalid (m/parse schema {"kukka" 42})))))
@@ -3310,7 +3314,7 @@
           value [:a]]
       (is (= true (m/validate schema value)))
       (is (= nil (m/explain schema value)))
-      (is (= [[:a :a]] (m/parse schema value)))
+      (is (= [(miu/-tagged :a :a)] (m/parse schema value)))
       (is (= value (m/unparse schema (m/parse schema value))))
       (is (= value (m/decode schema value nil))))))
 
@@ -3422,14 +3426,14 @@
         parsed (m/parse [:seqable [:orn [:l :int] [:r :boolean]]] original)
         unparsed (m/unparse [:seqable [:orn [:l :int] [:r :boolean]]] parsed)]
     (is (= original unparsed))
-    (is (= [[:l 0] [:r true] [:l 1] [:r false] [:l 2] [:r true] [:l 3] [:r false] [:l 4] [:r true] [:l 5]
-            [:r false] [:l 6] [:r true] [:l 7] [:r false] [:l 8] [:r true] [:l 9] [:r false]]
+    (is (= [(miu/-tagged :l 0) (miu/-tagged :r true) (miu/-tagged :l 1) (miu/-tagged :r false) (miu/-tagged :l 2) (miu/-tagged :r true) (miu/-tagged :l 3) (miu/-tagged :r false) (miu/-tagged :l 4) (miu/-tagged :r true) (miu/-tagged :l 5)
+            (miu/-tagged :r false) (miu/-tagged :l 6) (miu/-tagged :r true) (miu/-tagged :l 7) (miu/-tagged :r false) (miu/-tagged :l 8) (miu/-tagged :r true) (miu/-tagged :l 9) (miu/-tagged :r false)]
            parsed)))
   (let [original (sorted-set 1 2 3)
         parsed (m/parse [:seqable [:orn [:a :int]]] original)
         unparsed (m/unparse [:seqable [:orn [:a :int]]] parsed)]
     (is (= unparsed [1 2 3]))
-    (is (= parsed [[:a 1] [:a 2] [:a 3]]))))
+    (is (= parsed [(miu/-tagged :a 1) (miu/-tagged :a 2) (miu/-tagged :a 3)]))))
 
 (deftest every-schema-test
   (is (m/validate [:every :int] nil))

test/malli/destructure_test.cljc

@@ -46,25 +46,48 @@
     :schema [:cat
              :any
              [:orn
-              [:map [:map
-                     [:b {:optional true} :any]
-                     ["c" {:optional true} :any]
-                     ['d {:optional true} :any]
-                     ['demo/e {:optional true} :any]
-                     [:demo/f {:optional true}]
-                     [:demo/g {:optional true}]
-                     [123 {:optional true} :any]]]
+              ;; Unfortunately, the output order is different between clj and cljs, and we use strict equality in the test
+              [:map #?(:clj
+                       [:map
+                        [:b {:optional true} :any]
+                        ["c" {:optional true} :any]
+                        ['d {:optional true} :any]
+                        ['demo/e {:optional true} :any]
+                        [:demo/f {:optional true}]
+                        [123 {:optional true} :any]
+                        [:demo/g {:optional true}]]
+                       :cljs
+                       [:map
+                        [:b {:optional true} :any]
+                        ["c" {:optional true} :any]
+                        ['d {:optional true} :any]
+                        ['demo/e {:optional true} :any]
+                        [:demo/f {:optional true}]
+                        [:demo/g {:optional true}]
+                        [123 {:optional true} :any]])]
               [:args [:schema
-                      [:*
-                       [:alt
-                        [:cat [:= :b] :any]
-                        [:cat [:= "c"] :any]
-                        [:cat [:= 'd] :any]
-                        [:cat [:= 'demo/e] :any]
-                        [:cat [:= :demo/f] :demo/f]
-                        [:cat [:= :demo/g] :demo/g]
-                        [:cat [:= 123] :any]
-                        [:cat [:not [:enum :b "c" 'd 'demo/e :demo/f :demo/g 123]] :any]]]]]]]
+                      #?(:clj
+                         [:*
+                          [:alt
+                           [:cat [:= :b] :any]
+                           [:cat [:= "c"] :any]
+                           [:cat [:= 'd] :any]
+                           [:cat [:= 'demo/e] :any]
+                           [:cat [:= :demo/f] :demo/f]
+                           [:cat [:= 123] :any]
+                           [:cat [:= :demo/g] :demo/g]
+                           [:cat [:not [:enum :b "c" 'd 'demo/e :demo/f 123 :demo/g]] :any]]]
+                         :cljs
+                         [:*
+                          [:alt
+                           [:cat [:= :b] :any]
+                           [:cat [:= "c"] :any]
+                           [:cat [:= 'd] :any]
+                           [:cat [:= 'demo/e] :any]
+                           [:cat [:= :demo/f] :demo/f]
+                           [:cat [:= :demo/g] :demo/g]
+                           [:cat [:= 123] :any]
+                           [:cat [:not [:enum :b "c" 'd 'demo/e :demo/f :demo/g 123]] :any]]])]]]]
     :errors '[[{::keysz [z]}]
               [{:kikka/keyz [z]}]]}
    {:name "map destructuring with required-keys"

test/malli/distributive_test.cljc

@@ -139,7 +139,7 @@
               [4 [:map [:y [:= 2]] [:z [:= 4]]]]]]])))
 
 (deftest parse-distributive-multi-test
-  (is (= [1 [3 {:y 1, :z 3}]]
+  (is (= (miu/-tagged 1 (miu/-tagged 3 {:y 1, :z 3}))
          (m/parse
            [:merge
             [:multi {:dispatch :y}

test/malli/util_test.cljc

@@ -878,7 +878,7 @@
                 [:z {:optional true} :boolean]] (m/form (m/deref s))))
         (is (= true (m/validate s {:x "x", :y 1, :z true})))
         (is (= false (m/validate s {:x "x", :y "y"})))
-        (is (= {:x [:str "x"], :y 1, :z true} (m/parse s {:x "x", :y 1, :z true})))))
+        (is (= {:x (miu/-tagged :str "x"), :y 1, :z true} (m/parse s {:x "x", :y 1, :z true})))))
 
     (testing "union"
       (let [s (->> [:union
@@ -891,7 +891,7 @@
         (is (= [:map [:x [:or [:orn [:str :string]] :int]]] (m/form (m/deref s))))
         (is (= true (m/validate s {:x "x"}) (m/validate s {:x 1})))
         (is (= false (m/validate s {:x true})))
-        (is (= {:x [:str "x"]} (m/parse s {:x "x"})))
+        (is (= {:x (miu/-tagged :str "x")} (m/parse s {:x "x"})))
         (is (= {:x 1} (m/parse s {:x 1})))))
 
     (testing "merge vs union"
@@ -942,7 +942,7 @@
                (m/form (m/deref s))))
         (is (= true (m/validate s {:x "x", :z "z"})))
         (is (= false (m/validate s {:x "x", :y "y" :z "z"})))
-        (is (= {:x [:str "x"], :z "z"} (m/parse s {:x "x", :z "z"})))))))
+        (is (= {:x (miu/-tagged :str "x"), :z "z"} (m/parse s {:x "x", :z "z"})))))))
 
 (def Int (m/schema int?))