(defn ^:skip-wiki map-spec-impl
"Do not call this directly, use 'spec' with a map argument"
[{:keys [req-un opt-un keys-pred pred-exprs opt-keys req-specs req req-keys opt-specs pred-forms opt gfn]
:as argm}]
(let [k->s (zipmap (concat req-keys opt-keys) (concat req-specs opt-specs))
keys->specnames #(c/or (k->s %) %)
id (java.util.UUID/randomUUID)]
(reify
Specize
(specize* [s] s)
(specize* [s _] s)
Spec
(conform* [_ m]
(if (keys-pred m)
(let [reg (registry)]
(loop [ret m, [[k v] & ks :as keys] m]
(if keys
(let [sname (keys->specnames k)]
(if-let [s (get reg sname)]
(let [cv (conform s v)]
(if (invalid? cv)
::invalid
(recur (if (identical? cv v) ret (assoc ret k cv))
ks)))
(recur ret ks)))
ret)))
::invalid))
(unform* [_ m]
(let [reg (registry)]
(loop [ret m, [k & ks :as keys] (c/keys m)]
(if keys
(if (contains? reg (keys->specnames k))
(let [cv (get m k)
v (unform (keys->specnames k) cv)]
(recur (if (identical? cv v) ret (assoc ret k v))
ks))
(recur ret ks))
ret))))
(explain* [_ path via in x]
(if-not (map? x)
[{:path path :pred 'map? :val x :via via :in in}]
(let [reg (registry)]
(apply concat
(when-let [probs (->> (map (fn [pred form] (when-not (pred x) form))
pred-exprs pred-forms)
(keep identity)
seq)]
(map
#(identity {:path path :pred % :val x :via via :in in})
probs))
(map (fn [[k v]]
(when-not (c/or (not (contains? reg (keys->specnames k)))
(pvalid? (keys->specnames k) v k))
(explain-1 (keys->specnames k) (keys->specnames k) (conj path k) via (conj in k) v)))
(seq x))))))
(gen* [_ overrides path rmap]
(if gfn
(gfn)
(let [rmap (inck rmap id)
gen (fn [k s] (gensub s overrides (conj path k) rmap k))
ogen (fn [k s]
(when-not (recur-limit? rmap id path k)
[k (gen/delay (gensub s overrides (conj path k) rmap k))]))
req-gens (map gen req-keys req-specs)
opt-gens (remove nil? (map ogen opt-keys opt-specs))]
(when (every? identity (concat req-gens opt-gens))
(let [reqs (zipmap req-keys req-gens)
opts (into {} opt-gens)]
(gen/bind (gen/choose 0 (count opts))
#(let [args (concat (seq reqs) (when (seq opts) (shuffle (seq opts))))]
(->> args
(take (c/+ % (count reqs)))
(apply concat)
(apply gen/hash-map)))))))))
(with-gen* [_ gfn] (map-spec-impl (assoc argm :gfn gfn)))
(describe* [_] (cons `keys
(cond-> []
req (conj :req req)
opt (conj :opt opt)
req-un (conj :req-un req-un)
opt-un (conj :opt-un opt-un)))))))