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

Add sequence, more generic monad tests

Browse source
This commit is contained in:
Correl Roush 2014-04-25 01:06:19 -04:00
parent 7bd6d5963e
commit f923b68374
3 changed files with 47 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
include/monad-tests.lfe
View file

@ -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)))

12
include/monads.lfe
View file

@ -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))))

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

@ -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