Unbreak inline :or matching.

Author: cresh

src/active/clojure/match.clj

@@ -315,7 +315,6 @@
   [& exclusions]
   (complement (apply some-fn exclusions)))
 
-
 (s/def ::regex regex?)
 (s/def ::compare-fn-token #{:compare-fn})
 (s/def ::fn? any?)
@@ -347,7 +346,7 @@
 
 (s/def ::path-exists-without-binding
   (s/or :flat ::path
-                        :list (s/cat :path ::path)))
+        :list (s/cat :path ::path)))
 
 (s/def ::path-exists-with-binding
   (s/cat :path ::path :binding-key ::binding-key :binding ::binding))
@@ -484,7 +483,7 @@
           :optional-path-with-default-binding
           (let [path (mapv make-key (:path body))
                 b    (make-binding (:binding body))]
-              `(optional-path-with-default-binding-clause ~path ~(:default-value body) ~b)))))))
+            `(optional-path-with-default-binding-clause ~path ~(:default-value body) ~b)))))))
 
 (defmacro parse-clauses
   [cs]
@@ -550,12 +549,15 @@
           :key-matches-without-binding
           (let [k           (make-key (:key body))
                 match       (:match-value body)
-                predicate?  (= :compare-fn (first match))
+                match-kind  (first match)
                 match-value (second match)]
             (cond
-              predicate?
+              (= :compare-fn match-kind)
               [`({~k ~'_} :guard [(constantly (~(:fn match-value) (get-in ~message [~k])))])
                `[]]
+              (= :options match-kind)
+              [`{~k (:or ~@(:options match-value))}
+               `[]]
               :else
               [`{~k ~match-value}
                `[]]))
@@ -564,46 +566,54 @@
           (let [k           (make-key (:key body))
                 b           (make-binding (:binding body))
                 match       (:match-value body)
-                predicate?  (= :compare-fn (first match))
+                match-kind  (first match)
                 match-value (second match)]
             (cond
-              predicate?
+              (= :compare-fn match-kind)
               [`({~k ~'_} :guard [(constantly (~(:fn match-value) (get-in ~message [~k])))])
                `[~(symbol b) (get-in ~message [~k])]]
+              (= :options match-kind)
+              [`{~k (:or ~@(:options match-value))}
+               `[~(symbol b) (get-in ~message [~k])]]
               :else
               [`{~k ~match-value}
                `[~(symbol b) (get-in ~message [~k])]]))
 
           :optional-key-with-default-binding
           (let [k           (make-key (:key body))
                 b           (make-binding (:binding body))]
-              [{} `[~(symbol b) (get-in ~message [~k] ~(:default-value body))]])
+            [{} `[~(symbol b) (get-in ~message [~k] ~(:default-value body))]])
 
           :path-matches-without-binding
           (let [path        (mapv make-key (:path body))
                 match       (:match-value body)
-                predicate?  (= :compare-fn (first match))
-                match-value (second match)
-                path-map    (assoc-in {} path match-value)]
+                match-kind  (first match)
+                match-value (second match)]
             (cond
-              predicate?
+              (= :compare-fn match-kind)
               [`(~(fold-path path '_) :guard [(constantly (~(:fn match-value) (get-in ~message ~path)))])
                `[]]
+              (= :options match-kind)
+              [(assoc-in {} path `(:or ~@(:options match-value)))
+               `[]]
               :else
-              [`~path-map
+              [`~(assoc-in {} path match-value)
                `[]]))
 
           :path-matches-with-binding
           (let [path        (mapv make-key (:path body))
                 b           (make-binding (:binding body))
                 match       (:match-value body)
-                predicate?  (= :compare-fn (first match))
+                match-kind  (first match)
                 match-value (second match)
                 path-map    (assoc-in {} path match-value)]
             (cond
-              predicate?
+              (= :compare-fn match-kind)
               [`(~(fold-path path '_) :guard [(constantly (~(:fn match-value) (get-in ~message ~path)))])
                `[~(symbol b) (get-in ~message ~path)]]
+              (= :options match-kind)
+              [(assoc-in {} path `(:or ~@(:options match-value)))
+               `[~(symbol b) (get-in ~message ~path)]]
               :else
               [`~path-map
                `[~(symbol b) (get-in ~message ~path)]]))
@@ -625,11 +635,11 @@
 (defn parse-emit-match-syntax
   [message [pattern rhs]]
   (let [[lhss rhss] (reduce (fn [[clauses bindings] c]
-                           (let [[clause binding] (parse-emit-syntax message c)]
-                             [(conj clauses clause)
-                              (conj bindings binding)]))
-                         [[] []]
-                         pattern)]
+                              (let [[clause binding] (parse-emit-syntax message c)]
+                                [(conj clauses clause)
+                                 (conj bindings binding)]))
+                            [[] []]
+                            pattern)]
     [(apply deep-merge lhss)
      `(let ~(into [] (apply concat rhss))
         ~rhs)]))

test/active/clojure/match_test.clj

@@ -44,8 +44,7 @@
     (t/testing "with regex"
       (let [c (p/parse-clause (:k #"foo"))]
         (t/is (= :k (p/key-matches-without-binding-clause-key c)))
-        (t/is (= "foo" (.pattern ^java.util.regex.Pattern (p/regex-matcher-regex (p/key-matches-without-binding-clause-matcher c)))))
-        ))
+        (t/is (= "foo" (.pattern ^java.util.regex.Pattern (p/regex-matcher-regex (p/key-matches-without-binding-clause-matcher c)))))))
     (t/testing "with any other value"
       (t/is (= (p/make-key-matches-without-binding-clause :k (p/make-constant-matcher "foo"))
                (p/parse-clause (:k "foo"))))))
@@ -149,10 +148,10 @@
 (t/deftest path-matches-with-binding-clause->rhs-match-test
   (t/is (= `[~(symbol "z") (get-in {:x {:y {:z "b"}}} [:x :y :z] "b")]
            (p/path-matches-with-binding-clause->rhs-match {:x {:y {:z "b"}}}
-                                             (p/path-matches-with-binding-clause [:x :y :z] (p/match-const "b") "z"))))
+                                                          (p/path-matches-with-binding-clause [:x :y :z] (p/match-const "b") "z"))))
   (t/is (= `[~(symbol "rebind") (get-in {:x {:y {:z "b"}}} [:x :y :z] "b")]
            (p/path-matches-with-binding-clause->rhs-match {:x {:y {:z "b"}}}
-                                             (p/path-matches-with-binding-clause [:x :y :z] (p/match-const "b") "rebind")))))
+                                                          (p/path-matches-with-binding-clause [:x :y :z] (p/match-const "b") "rebind")))))
 
 (t/deftest reduce-lhs-test
   (t/is (empty? (p/reduce-lhs [])))
@@ -172,7 +171,6 @@
                           {:a 42}
                           (list {:z '_} :guard [:guard-3])]))))
 
-
 ;; Testing Macro
 
 (def one-data
@@ -235,9 +233,9 @@
       (t/is (= false (example-matcher three-data)))))
   (t/testing "Paths"
     (t/is (= [{}] ((p/map-matcher [([:a] :as a)] [a]) {:a {}})))
-    (t/is (= [] ((p/map-matcher [([:a b] "c")] []) {:a { "b" "c"}})))
-    (t/is (= [] ((p/map-matcher [([:a b c] "d")] []) {:a { "b" {"c" "d"}}})))
-    (t/is (= ["d"] ((p/map-matcher [([:a b c] "d" :as z)] [z]) {:a { "b" {"c" "d"}}})))))
+    (t/is (= [] ((p/map-matcher [([:a b] "c")] []) {:a {"b" "c"}})))
+    (t/is (= [] ((p/map-matcher [([:a b c] "d")] []) {:a {"b" {"c" "d"}}})))
+    (t/is (= ["d"] ((p/map-matcher [([:a b c] "d" :as z)] [z]) {:a {"b" {"c" "d"}}})))))
 
 (t/deftest map-matcher-optional-test
   (t/testing "Optional values"
@@ -282,8 +280,7 @@
     (t/is (= ["D"] ((p/map-matcher [(? [:a b c] "D" :as a)] [a]) {:a "b"})))
     (t/is (= ["D"] ((p/map-matcher [(? [:a b c] "D" :as a)] [a]) {:a {"b" {}}})))
     (t/is (= ["D"] ((p/map-matcher [(? [:a b c] "D" :as a)] [a]) {:a {"b" {"e" "d"}}})))
-    (t/is (= ["d"] ((p/map-matcher [(? [:a b c] "D" :as a)] [a]) {:a {"b" {"c" "d"}}})))
-    ))
+    (t/is (= ["d"] ((p/map-matcher [(? [:a b c] "D" :as a)] [a]) {:a {"b" {"c" "d"}}})))))
 
 (p/defpattern one-or
   [(:kind #"one")
@@ -306,6 +303,44 @@
              (example-or-matcher two-data)))
     (t/is (= false (example-or-matcher {:kind "none"})))))
 
+(def example-or-matcher-inline
+  (p/map-matcher
+   [(:kind #"one")
+    (:x (:or "a" "b" "c" "x") :as x)
+    (:y (:or "x" "y" "z"))
+    (:z :as z)
+    :w]
+   [x z]
+   two [a c Z Y]
+   :else false))
+
+(t/deftest map-matcher-or-inline-test
+  (t/testing "Alternative values to match on"
+    (t/is (= ["x" "z"]
+             (example-or-matcher-inline one-data)))
+    (t/is (= ["a" "c" 42 23]
+             (example-or-matcher-inline two-data)))
+    (t/is (= false (example-or-matcher {:kind "none"})))))
+
+(def example-or-matcher-inline-path
+  (p/map-matcher
+   [([:path :kind] #"one")
+    ([:path :x] (:or "a" "b" "c" "x") :as x)
+    ([:path :y] (:or "x" "y" "z"))
+    ([:path :z] :as z)
+    [:path :w]]
+   [x z]
+   two [a c Z Y]
+   :else false))
+
+(t/deftest map-matcher-or-inline-path-test
+  (t/testing "Alternative values to match on"
+    (t/is (= ["x" "z"]
+             (example-or-matcher-inline-path {:path one-data})))
+    (t/is (= ["a" "c" 42 23]
+             (example-or-matcher-inline-path two-data)))
+    (t/is (= false (example-or-matcher {:kind "none"})))))
+
 (p/defpattern predicate-pattern
   [(:x (:compare-fn even?))])
 
@@ -379,13 +414,13 @@
                ((p/map-matcher p x)
                 evt)))))
   #_(t/testing "as constant with local parse-pattern"
-    (let [x   "x"
-          evt {"X" x}
-          p   (p/parse-pattern [(X x)])]
-      (t/is (= x
+      (let [x   "x"
+            evt {"X" x}
+            p   (p/parse-pattern [(X x)])]
+        (t/is (= x
                ;; Caused by java.lang.UnsupportedOperationException Can't eval locals
-               ((p/map-matcher p x)
-                evt))))))
+                 ((p/map-matcher p x)
+                  evt))))))
 
 (def doc-string-example-map-matcher
   (p/map-matcher
@@ -394,14 +429,14 @@
     (:z :as z)
     :w]
    (println x z)
-    [(:a "a" :as a)
-     (:b "b")
-     (:c :as c)
-     ([:d] :as d)
-     ([:d Z] 42 :as Z)
-     ([:d Y] :as Y)
-     ([:d X] 65)
-     [:d W foo]]
+   [(:a "a" :as a)
+    (:b "b")
+    (:c :as c)
+    ([:d] :as d)
+    ([:d Z] 42 :as Z)
+    ([:d Y] :as Y)
+    ([:d X] 65)
+    [:d W foo]]
    (println a c d Z Y)
    :else false))