Merge pull request #248 from carloshernandez2/test-new-cats-mlet-macro-2

Support missing destructuring scenarios in mlet for version 2.4.3

Author: sovelten

project.clj

@@ -1,9 +1,9 @@
-(defproject funcool/cats "2.4.3-beta.1"
+(defproject funcool/cats "2.4.3-beta.2"
   :description "Category Theory abstractions for Clojure"
   :url         "https://github.com/funcool/cats"
   :license {:name "BSD (2 Clause)"
             :url  "http://opensource.org/licenses/BSD-2-Clause"}
-  :dependencies [[org.clojure/clojure "1.9.0" :scope "provided"]
+  :dependencies [[org.clojure/clojure "1.10.0" :scope "provided"]
                  [org.clojure/clojurescript "1.10.439" :scope "provided"]
                  [org.clojure/core.async "0.4.474" :scope "provided"]
                  [org.clojure/test.check "0.9.0" :scope "provided"]

src/cats/core.cljc

@@ -34,6 +34,7 @@
      :clj
      (:require [cats.protocols :as p]
                [clojure.set]
+               [clojure.walk :as walk]
                [cats.context :as ctx]))
   (:refer-clojure :exclude [filter sequence unless when for]))
 
@@ -229,21 +230,26 @@
 ;; Monadic Let Macro
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defn- flatten-bindings
-  [bindings]
-  (filterv symbol? (tree-seq coll? seq bindings)))
-
-(defn- parse-step
-  [[l r] fn-bindings fn-sym]
-  (case l
-    :let
-    (let [normalized-bindings (flatten-bindings (conj fn-bindings (take-nth 2 r)))]
-      [`(let ~r (~fn-sym ~@normalized-bindings)) normalized-bindings])
-    :when
-    (let [normalized-bindings (flatten-bindings fn-bindings)]
-      [`(bind (guard ~r) (partial ~fn-sym ~@normalized-bindings)) (conj normalized-bindings '_)])
-    (let [normalized-bindings (flatten-bindings fn-bindings)]
-      [`(bind ~r (partial ~fn-sym ~@normalized-bindings)) (conj normalized-bindings l)])))
+#?(:clj
+   (defn- extract-bound-symbols
+     [bindings]
+     (->> bindings
+          (walk/prewalk #(if (map? %) (dissoc (update % :keys (partial map (comp symbol name))) :or) %))
+          (tree-seq coll? seq)
+          (filterv #(and (symbol? %) (not= '& %))))))
+
+#?(:clj
+   (defn- parse-step
+     [[l r] fn-bindings fn-sym]
+     (case l
+       :let
+       (let [normalized-bindings (extract-bound-symbols (conj fn-bindings (take-nth 2 r)))]
+         [`(let ~r (~fn-sym ~@normalized-bindings)) normalized-bindings])
+       :when
+       (let [normalized-bindings (extract-bound-symbols fn-bindings)]
+         [`(bind (guard ~r) (partial ~fn-sym ~@normalized-bindings)) (conj normalized-bindings '_)])
+       (let [normalized-bindings (extract-bound-symbols fn-bindings)]
+         [`(bind ~r (partial ~fn-sym ~@normalized-bindings)) (conj normalized-bindings l)]))))
 
 #?(:clj
    (defmacro mlet

test/cats/core_spec.cljc

@@ -30,10 +30,11 @@
 
 (t/deftest mlet-tests
   (t/testing "Support regular let bindings inside mlet"
-    (t/is (= (maybe/just 2)
-             (m/mlet [{i :i j :j} (maybe/just {:i 1 :j 0})
-                      :let [i (inc i)]]
-               (m/return (+ i j))))))
+    (t/is (= (maybe/just 20)
+             (m/mlet [[{:n/keys [a b c] y2 :i j :j :or {c 'yes}}] (maybe/just [{:i 1 :j 1 :n/a 2 :n/b 3}])
+                      :let [[[x1 y1] [x2 & [y2]] & remaining :as all-vec] (sorted-map j a b 4)]
+                      {age :age :keys [m/w ::m/z :zero] :or {z 5 w 5} :as all-map} (m/return {:age (+ x1 x2 y1 y2) :zero 0})]
+                     (m/return (when (= c 'yes) (+ zero w z age)))))))
 
   (t/testing "Support :when guards inside its bindings"
     (t/is (= (maybe/nothing)