2014-04-24 19:33:28 +00:00
|
|
|
(defmodule unit-maybe-monad-tests
|
2014-04-24 04:47:45 +00:00
|
|
|
(export all)
|
|
|
|
(import
|
|
|
|
(from lfeunit-util
|
|
|
|
(check-failed-assert 2)
|
|
|
|
(check-wrong-assert-exception 2))))
|
|
|
|
|
|
|
|
(include-lib "deps/lfeunit/include/lfeunit-macros.lfe")
|
2014-04-24 19:33:28 +00:00
|
|
|
(include-lib "include/monads.lfe")
|
2014-04-25 04:20:10 +00:00
|
|
|
(include-lib "include/monad-tests.lfe")
|
2014-04-24 04:47:45 +00:00
|
|
|
|
2014-04-25 05:06:19 +00:00
|
|
|
(test-monad maybe-monad)
|
2014-04-25 04:20:10 +00:00
|
|
|
|
|
|
|
(deftest bind-short-circuit-value
|
2014-04-24 04:47:45 +00:00
|
|
|
(is-equal 'nothing
|
2014-04-24 19:33:28 +00:00
|
|
|
(>>= maybe-monad 'nothing
|
2014-04-24 04:47:45 +00:00
|
|
|
(lambda (x) (+ 5 x)))))
|
|
|
|
|
2014-04-25 04:20:10 +00:00
|
|
|
(deftest bind-short-circuit-error
|
2014-04-24 04:47:45 +00:00
|
|
|
(is-equal 'nothing
|
2014-04-24 19:33:28 +00:00
|
|
|
(>>= maybe-monad 'nothing
|
2014-04-24 04:47:45 +00:00
|
|
|
(lambda (_) (error 'bad-func)))))
|
|
|
|
|
2014-04-25 04:20:10 +00:00
|
|
|
(deftest bind
|
2014-04-24 04:47:45 +00:00
|
|
|
(is-equal 10
|
2014-04-24 19:33:28 +00:00
|
|
|
(>>= maybe-monad (tuple 'just 5)
|
2014-04-24 04:47:45 +00:00
|
|
|
(lambda (x) (+ 5 x)))))
|
|
|
|
|
|
|
|
(deftest bind-fold
|
|
|
|
(is-equal #(just 3)
|
2014-04-24 19:33:28 +00:00
|
|
|
(let ((minc (lambda (x) (return maybe-monad (+ 1 x))))
|
|
|
|
(bind (lambda (f m) (>>= maybe-monad m f))))
|
2014-04-24 04:47:45 +00:00
|
|
|
(lists:foldr bind
|
|
|
|
#(just 0)
|
|
|
|
(list minc
|
|
|
|
minc
|
|
|
|
minc)))))
|
|
|
|
|
2014-04-24 13:47:12 +00:00
|
|
|
(deftest do-bindings
|
2014-04-24 04:47:45 +00:00
|
|
|
(is-equal #(just 3)
|
2014-04-24 19:33:28 +00:00
|
|
|
(do maybe-monad
|
|
|
|
(a <- #(just 1))
|
|
|
|
(b <- #(just 2))
|
|
|
|
(return maybe-monad (+ a b)))))
|
2014-04-24 13:47:12 +00:00
|
|
|
|
|
|
|
(deftest do-nobindings
|
|
|
|
(is-equal #(just 3)
|
2014-04-24 19:33:28 +00:00
|
|
|
(do maybe-monad
|
|
|
|
#(just 5)
|
2014-04-25 04:20:10 +00:00
|
|
|
#(just 3))))
|