[issue scgilardi#23] generalize key-value pair selector to key-values

CHANGES

@@ -57,4 +57,5 @@
     support for testing that the proper exception is thrown (issue 21)
   - remove replace-all and % substitution in source in favor of using
     let to bind % (issue 22)
-
+  - key-value pair -> key-values, generalize key-value selector to
+    allow any even number of items in the vector (issue 23)

README.md

@@ -34,8 +34,8 @@ Enhanced throw and catch for Clojure
     - a **class name**: (e.g., `RuntimeException`, `my.clojure.record`),
       matches any instance of that class, or
 
-    - a **key-value pair**: (two element vector), matches objects where
-      `(get object key)` returns `val`, or
+    - a **key-values**: (e.g., `[key val & kvs]`), matches objects
+      where `(and (= (get object key) val ...))`, or
 
     - a **predicate**: (function of one argument like `map?`, `set?`),
       matches any Object for which the predicate returns a truthy
@@ -45,12 +45,12 @@ Enhanced throw and catch for Clojure
       `%` to be replaced by the thrown object, matches any object for
       which the form evaluates to truthy.
 
-    - the class name, key-value pair, and predicate selectors are
+    - the class name, key-values, and predicate selectors are
       shorthand for these selector forms:
 
           `<class name>  => (instance? <class name> %)`
 
-          `[<key> <val>] => (= (get % <key>) <val>)`
+          `[<key> <val> & <kvs>] => (and (= (get % <key>) <val>) ...)`
 
           `<predicate>   => (<predicate> %)`
 

src/slingshot/slingshot.clj

@@ -7,7 +7,7 @@
     - catch non-Throwable objects thrown by throw+ as well as
       Throwable objects thrown by throw or throw+;
 
-    - specify objects to catch by class name, key-value pair,
+    - specify objects to catch by class name, key-values,
       predicate, or arbitrary selector form;
 
     - destructure the caught object;
@@ -20,12 +20,12 @@
   be replaced by the thrown object. If it evaluates to truthy, the
   object is caught.
 
-    The class name, key-value pair, and predicate selectors are
+    The class name, key-values, and predicate selectors are
     shorthand for these selector forms:
 
-      <class name>  => (instance? <class name> %)
-      [<key> <val>] => (= (get % <key>) <val>)
-      <predicate>   => (<predicate> %)
+      <class name>          => (instance? <class name> %)
+      [<key> <val> & <kvs>] => (and (= (get % <key>) <val>) ...)
+      <predicate>           => (<predicate> %)
 
   The binding form in a try+ catch clause is not required to be a
   simple symbol. It is subject to destructuring which allows easy

src/slingshot/support.clj

@@ -153,20 +153,20 @@
              [(class-name []
                 (and (symbol? selector) (class? (resolve selector))
                      `(instance? ~selector ~'%)))
-              (key-value []
+              (key-values []
                 (and (vector? selector)
-                     (if (= (count selector) 2)
-                       (let [[key val] selector]
-                         `(= (get ~'% ~key) ~val))
-                       (throw-arg "key-value selector: %s does not match: %s"
-                                  (pr-str selector) "[key val]"))))
+                     (if (even? (count selector))
+                       `(and ~@(for [[key val] (partition 2 selector)]
+                                 `(= (get ~'% ~key) ~val)))
+                       (throw-arg "key-values selector: %s does not match: %s"
+                                  (pr-str selector) "[key val & kvs]"))))
               (selector-form []
                 (and (seq? selector) (appears-within? '% selector)
                      selector))
               (predicate []
                 `(~selector ~'%))]
            `(let [~'% (:object ~'&throw-context)]
-              ~(or (class-name) (key-value) (selector-form) (predicate)))))
+              ~(or (class-name) (key-values) (selector-form) (predicate)))))
        (cond-expression [binding-form expressions]
          `(let [~binding-form (:object ~'&throw-context)]
             ~@expressions))

test/slingshot/test/slingshot.clj

@@ -49,6 +49,10 @@
     (catch [:a-key 4] e#
       [:key-yields-value e#])
 
+    ;; by multiple-key-value
+    (catch [:key1 4 :key2 5] e#
+      [:keys-yield-values e#])
+
     ;; by key present
     (catch (contains? ~'% :a-key) e#
       [:key-is-present e#])
@@ -70,7 +74,6 @@
       [:pred-map e# (meta e#)])))
 
 (deftest test-try+
-
   (testing "catch by class derived from Throwable"
     (testing "treat throwables exactly as throw does, interop with try/throw"
       (is (= [:class-exception exception-1]
@@ -90,9 +93,13 @@
     (is (= [:class-exception-record exception-record-1]
            (mega-try (throw+ exception-record-1)))))
 
-  (testing "catch by key, with optional value"
-    (is (= [:key-is-present #{:a-key}] (mega-try (throw+ #{:a-key}))))
-    (is (= [:key-yields-value {:a-key 4}] (mega-try (throw+ {:a-key 4})))))
+  (testing "catch by key is present"
+    (is (= [:key-is-present #{:a-key}] (mega-try (throw+ #{:a-key})))))
+
+  (testing "catch by keys and values"
+    (is (= [:key-yields-value {:a-key 4}] (mega-try (throw+ {:a-key 4}))))
+    (is (= [:keys-yield-values {:key1 4 :key2 5}]
+           (mega-try (throw+ {:key1 4 :key2 5})))))
 
   (testing "catch by clojure type with optional hierarchy"
     (is (= [:type-sphere ::sphere a-sphere] (mega-try (throw+ a-sphere))))