Haskell-inspired monadic do notation (#222)

EricVM · web-flow · commit 7fd5f9891e48 · 2018-12-11T11:58:56.000-02:00
* Introduce haskell-inspired do-let macro

* fix date
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,5 +1,11 @@
 # Changelog #
 
+## Version 2.3.2
+
+Date: 2018-11-07
+
+- Introduce haskell-inspired do-let macro
+
 ## Version 2.3.1 ##
 
 Date: 2018-10-31
diff --git a/project.clj b/project.clj
@@ -1,4 +1,4 @@
-(defproject funcool/cats "2.3.1"
+(defproject funcool/cats "2.3.2"
   :description "Category Theory abstractions for Clojure"
   :url         "https://github.com/funcool/cats"
   :license {:name "BSD (2 Clause)"
diff --git a/src/cats/core.cljc b/src/cats/core.cljc
@@ -1013,3 +1013,39 @@
   ([ctx f tv]
    (ctx/with-context ctx
      (p/-traverse (p/-get-context tv) f tv))))
+
+(defmacro do-let
+  "Haskell-inspired monadic do notation
+   it allows one to drop the _ when  we don't need the extracted value
+
+  Basically,
+  (do-let
+    a
+    b
+    [c d
+     e f]
+    x
+    y)
+
+  Translates into:
+
+  (mlet
+    [_ a
+     _ b
+     c d
+     e f
+     _ x]
+    y)
+  "
+  [& forms]
+  (assert (not (empty? forms)) "do-let must have at least one argument")
+  (assert (not (vector? (last forms))) "Last argument of do-let must not be a vector")
+  (if (= 1 (count forms))
+    `(do (assert (not (satisfies? p/Monad ~(first forms))) "Single argument of do-let must implement Monad protocol")
+         ~(first forms))
+    `(mlet ~(vec (reduce (fn [acc form]
+                           (cond (vector? form) (into acc form)
+                                 :else          (into acc ['_ form])))
+                         []
+                         (butlast forms)))
+       ~(last forms))))
diff --git a/test/cats/core_spec.cljc b/test/cats/core_spec.cljc
@@ -298,3 +298,36 @@
       (t/is (= (maybe/just 1)
                (ctx/with-context maybe/context
                  (m/foldm m-div 1 [])))))))
+
+(t/deftest do-let-tests
+  (t/testing "Support regular let bindings inside do-let"
+    (t/is (= (maybe/just 2)
+             (m/do-let [i (maybe/just 1)
+                        :let [i (inc i)]]
+               (m/return i)))))
+
+  (t/testing "Support :when guards inside its bindings"
+    (t/is (= (maybe/nothing)
+             (m/do-let [i (maybe/just 2)
+                        :when (> i 2)]
+               (m/return i))))
+    (t/is (= [3 4 5]
+             (m/do-let [i [1 2 3 4 5]
+                        :when (> i 2)]
+                       (m/return i)))))
+
+  (t/testing "Support one single form"
+    (t/is (= (maybe/just 2)
+             (m/do-let (maybe/just 2)))))
+
+  (t/testing "Support multiple single form"
+    (t/is (= (maybe/just 3)
+             (m/do-let (maybe/just 2)
+                       (maybe/just 3)))))
+
+  (t/testing "Bound variables are always in scope"
+    (t/is (= (maybe/just 6)
+             (m/do-let [x (maybe/just 2)]
+                       (maybe/just x)
+                       [y (maybe/just (+ 2 x))]
+                       (maybe/just (+ 2 y)))))))

Original file line number	Diff line number	Diff line change
`@@ -1,4 +1,4 @@`
`1`		`-(defproject funcool/cats "2.3.1"`
	`1`	`+(defproject funcool/cats "2.3.2"`
`2`	`2`	`:description "Category Theory abstractions for Clojure"`
`3`	`3`	`:url "https://github.com/funcool/cats"`
`4`	`4`	`:license {:name "BSD (2 Clause)"`