spec or

src/sci/configs/cljs/spec/alpha.cljs

@@ -1,11 +1,10 @@
 (ns sci.configs.cljs.spec.alpha
-  (:refer-clojure :exclude [defmacro and])
+  (:refer-clojure :exclude [and or])
   (:require [clojure.spec.alpha :as s]
-            [clojure.string :as str]
             [sci.core :as sci]
             [sci.ctx-store :as ctx]
             [clojure.walk :as walk])
-  (:require-macros [sci.configs.macros :as macros :refer [defmacro]]))
+  (:require-macros [sci.configs.macros :as macros]))
 
 (def sns (sci/create-ns 'cljs.spec.alpha nil))
 
@@ -59,7 +58,7 @@
                           (if (nil? form)
                             (dissoc r k)
                             (assoc r k form))))
-    `(cljs.spec.alpha/def-impl '~k '~form ~spec-form)))
+    `(s/def-impl '~k '~form ~spec-form)))
 
 (macros/defmacro and
   "Takes predicate/spec-forms, e.g.
@@ -70,12 +69,32 @@
   conformed values propagate through rest of predicates."
   [& pred-forms]
   (let [&env (ctx/get-ctx)]
-    `(cljs.spec.alpha/and-spec-impl '~(mapv #(res &env %) pred-forms) ~(vec pred-forms) nil)))
+    `(s/and-spec-impl '~(mapv #(res &env %) pred-forms) ~(vec pred-forms) nil)))
+
+(macros/defmacro or
+  "Takes key+pred pairs, e.g.
+
+  (s/or :even even? :small #(< % 42))
+
+  Returns a destructuring spec that returns a map entry containing the
+  key of the first matching pred and the corresponding value. Thus the
+  'key' and 'val' functions can be used to refer generically to the
+  components of the tagged return."
+  [& key-pred-forms]
+  (let [&env (ctx/get-ctx)
+        pairs (partition 2 key-pred-forms)
+        keys (mapv first pairs)
+        pred-forms (mapv second pairs)
+        pf (mapv #(res &env %) pred-forms)]
+    (clojure.core/assert (clojure.core/and (even? (count key-pred-forms)) (every? keyword? keys)) "spec/or expects k1 p1 k2 p2..., where ks are keywords")
+    `(s/or-spec-impl ~keys '~pf ~pred-forms nil)))
 
 (def namespaces {'cljs.spec.alpha {'def (sci/copy-var def* sns)
                                    'def-impl (sci/copy-var s/def-impl sns)
                                    'and (sci/copy-var and sns)
                                    'and-spec-impl (sci/copy-var s/and-spec-impl sns)
+                                   'or (sci/copy-var or sns)
+                                   'or-spec-impl (sci/copy-var s/or-spec-impl sns)
                                    'valid? (sci/copy-var s/valid? sns)}})
 
 (def config {:namespaces namespaces})