diff --git a/src/main/clojure/cljs/core.cljc b/src/main/clojure/cljs/core.cljc index e8d4fe146..a4cf7e74a 100644 --- a/src/main/clojure/cljs/core.cljc +++ b/src/main/clojure/cljs/core.cljc @@ -855,6 +855,45 @@ bindings (reduce process-entry [] bents)))) +(core/defn- selector-impl [m] + (core/let [dirs [:select :excess :missing :all] + names (zipmap (filter m dirs) (repeatedly gensym))] + (if (empty? names) + #?(:clj (throw (IllegalArgumentException. + "form must contain at least one of :select :excess :missing :all")) + :cljs (throw (js/Error. "form must contain at least one of :select :excess :missing :all"))) + `(fn ~(gensym "selector") + [map#] + (core/let [~(merge m names) map#] + ~(if (= 1 (count names)) + (core/-> names first val) + (core/list `some-vals names))))))) + +(core/defmacro selector + "Builds a selecting-fn from m, a map destructuring form that must + include one or more of the :select, :all, :missing, and :excess + directives. The return function takes a collection, destructures it + per m, and returns a map of the result(s). + + If m has exactly one directive, the result is the value that + directive would yield. If m has more than one directive, then it + returns a map of directives to values. + + As in destructuring, :missing controls whether missing required keys + throw or are collected. + + While a map destructuring form may and sometimes must include + bindings, selector doesn't produce bindings, thus ignoring the + associated directive names. + + Throws an exception if the argument is not a map." + {:added "1.13"} + [m] + (core/when-not (map? m) + #?(:clj (throw (IllegalArgumentException. "expected a map")) + :cljs (throw (js/Error. "expected a map")))) + (selector-impl m)) + (core/defmacro ^:private return-first [& body] `(let [ret# ~(first body)] diff --git a/src/test/cljs/cljs/core_test.cljs b/src/test/cljs/cljs/core_test.cljs index b3ad35b16..b0b18cf1e 100644 --- a/src/test/cljs/cljs/core_test.cljs +++ b/src/test/cljs/cljs/core_test.cljs @@ -2028,3 +2028,111 @@ (select-keys {:a 1 :b 2 :c nil} [:a :c :d]) {:a 1 :c nil} (select-keys nil [:a]) {} (select-keys #{:a :b} [:a :c]) {:a :a})) + +(deftest selector-test + (let [sample-map {:a 1 :b 2 :c 3 :d 4 + :e 5 + ::x 10000 + :nested {:aa 1 'saa 10}}] + + ;; these are compile time + #_(testing "error cases" + (is (thrown? js/Error (selector {:keys [a b]}))) + (is (thrown? js/Error (selector sample-map))) + (is (thrown? js/Error (selector nil))) + (is (thrown? js/Error (selector {})))) + + (testing "single directives return their values directly" + (let [ex1 (selector {:keys [a b & :c :z] + :keys! [d] + :select keys-sel})] + (is (= {:a 1 :b 2 :c 3 :d 4} + (ex1 sample-map))) + + (testing "checked keys without :missing should throw" + (is (thrown? js/Error (ex1 (dissoc sample-map :d))))) + + (testing ":select with :or" + (let [ex1 (selector {:keys [a b & :c :z] + :keys! [d] + :select keys-sel + :or {:z 42}})] + (is (= {:a 1 :b 2 :c 3 :d 4 :z 42} + (ex1 sample-map)))))) + + (let [ex1 (selector {:keys [a b & :c :z] + :keys! [d] + :all keys-all})] + (is (= sample-map (ex1 sample-map)))) + + (let [ex1 (selector {:keys [a b & :c :z] + :keys! [d] + :missing keys-missing})] + (is (nil? (ex1 sample-map))) + (is (= {:d nil} (ex1 (dissoc sample-map :d))))) + + (let [ex1 (selector {:keys [a b & :c :z] + :keys! [d] + :excess keys-excess})] + (is (= (dissoc sample-map :a :b :c :d) (ex1 sample-map))))) + + (testing ":select plus :missing, but nothing missing" + (let [ex2 (selector {:keys [a b & :c :z] + :keys! [d] + :select keys-sel + :missing keys-missing})] + (is (= {:select {:a 1 :b 2 :c 3 :d 4}} + (ex2 sample-map))))) + + (testing ":select plus :all" + (let [ex3 (selector {:keys [a b & :c :z] + :keys! [d] + :select keys-sel + :missing keys-missing + :all keys-all})] + (is (= {:select {:a 1 :b 2 :c 3 :d 4} + :all sample-map} + (ex3 sample-map))))) + + (testing ":select, :all, and :excess" + (let [ex4 (selector {:keys [a b & :c :z] + :keys! [d] + :select keys-sel + :missing keys-missing + :all keys-all + :excess keys-excess})] + (is (= {:select {:a 1 :b 2 :c 3 :d 4} + :excess (dissoc sample-map :a :b :c :d) + :all sample-map} + (ex4 sample-map))) + (testing "plus :missing" + (is (= {:d nil} + (:missing (ex4 (dissoc sample-map :d)))))))) + + (testing "directive names bound to _" + (let [ex_ (selector {:keys [a b & :c :z] + :keys! [d] + :select _ + :missing _ + :all _ + :excess _})] + (is (= {:select {:a 1 :b 2 :c 3 :d 4} + :excess (dissoc sample-map :a :b :c :d) + :all sample-map} + (ex_ sample-map))))) + + (testing "nested :select" + (let [exnest (selector {{aa :aa saa 'saa + :select nest-sel} :nested + aqx ::x + :select tl-sel})] + (is (= {::x 10000 :nested {:aa 1 'saa 10}} + (exnest sample-map))))) + + (testing "nested selection behavior with _ bindings" + (let [exnest_ (selector {{aa :aa saa 'saa + :select _} :nested + aqx ::x + :select _})] + (is (= {::x 10000 :nested {:aa 1 'saa 10}} + (exnest_ sample-map)))))))