github/calrissian
1
0
Fork 0
mirror of https://github.com/correl/calrissian.git synced 2024-11-23 19:19:57 +00:00
Code Issues Projects Releases Packages Wiki Activity

Add generic tests for monad laws

Browse source
This commit is contained in:
Correl Roush 2014-04-25 00:20:10 -04:00
parent 010e2c9327
commit 323cf28830
2 changed files with 51 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
include/monad-tests.lfe Normal file
View file

@ -0,0 +1,44 @@
(defmacro test-monad-laws (monad)
`(progn
(deftest monad-left-identity
(let ((a 3)
(f (lambda (n) (return ,monad (* 3 n)))))
(is-equal (>>= ,monad (return ,monad a) f)
(funcall f a))))
(deftest monad-right-identity
(let ((m (return ,monad 3)))
(is-equal (>>= ,monad m (lambda (m') (return ,monad m')))
m)))
(deftest monad-associativity
(let ((m (return ,monad 3))
(f (lambda (n) (return ,monad (* 3 n))))
(g (lambda (n) (return ,monad (+ 5 n)))))
(is-equal (>>= ,monad (>>= ,monad m f) g)
(>>= ,monad m (lambda (x) (>>= ,monad (funcall f x) g))))))
(deftest monad-do-left-identity
(let ((a 3)
(f (lambda (n) (return ,monad (* 3 n)))))
(is-equal (do ,monad (a' <- (return ,monad a))
(funcall f a'))
(do ,monad (funcall f a)))))
(deftest monad-do-right-identity
(let ((m (return ,monad 3)))
(is-equal (do ,monad (x <- m)
(return ,monad x))
(do ,monad m))))
(deftest monad-do-associativity
(let ((m (return ,monad 3))
(f (lambda (n) (return ,monad (* 3 n))))
(g (lambda (n) (return ,monad (+ 5 n)))))
(is-equal (do ,monad (y <- (do ,monad (x <- m)
(funcall f x)))
(funcall g y))
(do ,monad (x <- m)
(do ,monad (y <- (funcall f x))
(funcall g y))))))
))

9
test/unit/unit-maybe-monad-tests.lfe
View file

@ -7,18 +7,21 @@
(include-lib "deps/lfeunit/include/lfeunit-macros.lfe") (include-lib "deps/lfeunit/include/lfeunit-macros.lfe")
(include-lib "include/monads.lfe") (include-lib "include/monads.lfe")
(include-lib "include/monad-tests.lfe")
(deftest bind-nothing (test-monad-laws maybe-monad)
(deftest bind-short-circuit-value
(is-equal 'nothing (is-equal 'nothing
(>>= maybe-monad 'nothing (>>= maybe-monad 'nothing
(lambda (x) (+ 5 x))))) (lambda (x) (+ 5 x)))))
(deftest bind-nothing-error (deftest bind-short-circuit-error
(is-equal 'nothing (is-equal 'nothing
(>>= maybe-monad 'nothing (>>= maybe-monad 'nothing
(lambda (_) (error 'bad-func))))) (lambda (_) (error 'bad-func)))))
(deftest bind-five (deftest bind
(is-equal 10 (is-equal 10
(>>= maybe-monad (tuple 'just 5) (>>= maybe-monad (tuple 'just 5)
(lambda (x) (+ 5 x))))) (lambda (x) (+ 5 x)))))