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

Remove monad atom evaluation skipping in macros

Browse source
This commit is contained in:
Correl Roush 2014-05-13 19:30:46 -04:00
parent 5721c3fc58
commit 02ada611df
4 changed files with 22 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
include/monads.lfe
View file

@ -4,25 +4,16 @@
(monad:do-transform monad statements)))
(defmacro >>= (monad m f)
(if (: lfe-utils atom? monad)
`(call ',monad '>>= ,m ,f)
`(call ,monad '>>= ,m ,f)))
`(call ,monad '>>= ,m ,f))
(defmacro >> (monad m1 m2)
(let ((f `(lambda (_) ,m2)))
(if (: lfe-utils atom? monad)
`(call ',monad '>>= ,m1 ,f)
`(call ,monad '>>= ,m1 ,f))))
`(call ,monad '>>= ,m1 (lambda (_) , m2)))
(defmacro return (monad expr)
(if (: lfe-utils atom? monad)
`(call ',monad 'return ,expr)
`(call ,monad 'return ,expr)))
`(call ,monad 'return ,expr))
(defmacro fail (monad expr)
(if (: lfe-utils atom? monad)
`(call ',monad 'fail ,expr)
`(call ,monad 'fail ,expr)))
`(call ,monad 'fail ,expr))
(defmacro sequence (monad list)
`(: lists foldr

20
test/unit/unit-error-monad-tests.lfe
View file

@ -9,28 +9,28 @@
(include-lib "include/monads.lfe")
(include-lib "include/monad-tests.lfe")
(test-monad error-monad)
(test-monad 'error-monad)
(deftest return-ok
(is-equal 'ok
(return error-monad 'ok)))
(return 'error-monad 'ok)))
(deftest return-value
(is-equal #(ok 123)
(return error-monad 123)))
(return 'error-monad 123)))
(deftest fail-with-reason
(is-equal #(error reason)
(fail error-monad 'reason)))
(fail 'error-monad 'reason)))
(deftest fail-short-circuits-value
(is-equal (fail error-monad 'something-bad)
(>> error-monad
(fail error-monad 'something-bad)
(return error-monad 123))))
(is-equal (fail 'error-monad 'something-bad)
(>> 'error-monad
(fail 'error-monad 'something-bad)
(return 'error-monad 123))))
(deftest fail-short-circuits-error
(is-equal #(error something-bad)
(>> error-monad
(fail error-monad 'something-bad)
(>> 'error-monad
(fail 'error-monad 'something-bad)
(throw 'error))))

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

@ -9,12 +9,12 @@
(include-lib "include/monads.lfe")
(include-lib "include/monad-tests.lfe")
(test-monad identity-monad)
(test-monad 'identity-monad)
(deftest identity
(is-equal 'ok
(return identity-monad 'ok)))
(return 'identity-monad 'ok)))
(deftest fail-with-error
(is-throw #(error value)
(fail identity-monad 'value)))
(fail 'identity-monad 'value)))

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

@ -9,22 +9,22 @@
(include-lib "include/monads.lfe")
(include-lib "include/monad-tests.lfe")
(test-monad maybe-monad)
(test-monad 'maybe-monad)
(deftest nothing-short-circuits-value
(is-equal 'nothing
(>>= maybe-monad 'nothing
(>>= 'maybe-monad 'nothing
(lambda (x) (+ 5 x)))))
(deftest nothing-short-circuits-error
(is-equal 'nothing
(>>= maybe-monad 'nothing
(>>= 'maybe-monad 'nothing
(lambda (_) (error 'bad-func)))))
(deftest fold-increment-value
(is-equal #(just 3)
(let ((minc (lambda (x) (return maybe-monad (+ 1 x))))
(bind (lambda (f m) (>>= maybe-monad m f))))
(let ((minc (lambda (x) (return 'maybe-monad (+ 1 x))))
(bind (lambda (f m) (>>= 'maybe-monad m f))))
(lists:foldr bind
#(just 0)
(list minc