Add sequence, more generic monad tests

include/monad-tests.lfe

@@ -1,3 +1,32 @@
+(defmacro test-monad-functions (monad)
+  `(progn
+     (deftest monad->>=
+       (is-equal (return ,monad 2)
+                 (>>= ,monad
+                      (return ,monad 1)
+                      (lambda (n) (return ,monad (+ 1 n))))))
+     (deftest monad->>
+       (is-equal (return ,monad 1)
+                 (>> ,monad
+                     (return ,monad 5)
+                     (return ,monad 1))))
+     (deftest monad-do
+       (is-equal (return ,monad 'ok)
+                 (do ,monad
+                     (return ,monad 'ignored)
+                     (return ,monad 'ok))))
+     (deftest monad-do-binding
+       (is-equal (return ,monad 9)
+                 (do ,monad
+                     (a <- (return ,monad 3))
+                     (return ,monad (* a a)))))
+     (deftest monad-sequence
+       (is-equal (return ,monad (list 1 2 3))
+                 (sequence ,monad (list (return ,monad 1)
+                                        (return ,monad 2)
+                                        (return ,monad 3)))))
+     ))
+
 (defmacro test-monad-laws (monad)
   `(progn
      (deftest monad-left-identity
@@ -42,3 +71,8 @@
                      (do ,monad (y <- (funcall f x))
                        (funcall g y))))))
      ))
+
+(defmacro test-monad (monad)
+  `(progn
+     (test-monad-functions ,monad)
+     (test-monad-laws ,monad)))

include/monads.lfe

@@ -11,3 +11,15 @@
 
 (defmacro return (monad expr)
   `(: ,monad return ,expr))
+
+(defmacro sequence (monad list)
+  `(: lists foldr
+     (lambda (m acc) (mcons ,monad m acc))
+     (return ,monad [])
+     ,list))
+
+(defmacro mcons (monad m mlist)
+  `(do ,monad
+       (x <- ,m)
+     (rest <- ,mlist)
+     (return ,monad (cons x rest))))

test/unit/unit-maybe-monad-tests.lfe

@@ -9,7 +9,7 @@
 (include-lib "include/monads.lfe")
 (include-lib "include/monad-tests.lfe")
 
-(test-monad-laws maybe-monad)
+(test-monad maybe-monad)
 
 (deftest bind-short-circuit-value
   (is-equal 'nothing
@@ -36,10 +36,6 @@
                                  minc
                                  minc)))))
 
-(deftest >>
-  (is-equal #(just 3)
-            (>> maybe-monad #(just 5) #(just 3))))
-
 (deftest do-bindings
   (is-equal #(just 3)
             (do maybe-monad