github/calrissian
1
0
Fork 0
mirror of https://github.com/correl/calrissian.git synced 2024-12-24 03:00:20 +00:00
Code Issues Projects Releases Packages Wiki Activity

Add macros to simplify monad usage

Browse source
This commit is contained in:
Correl Roush 2014-07-09 22:28:06 -04:00
parent 0914cf5779
commit 99be83ee71
6 changed files with 37 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
include/monads.lfe
View file

@ -1,3 +1,14 @@
(defmacro monad (name)
`(list_to_atom (lists:flatten (list "calrissian-"
(atom_to_list ,name)
"-monad"))))
(defmacro transformer (name inner-monad)
`(tuple (list_to_atom (lists:flatten (list "calrissian-"
(atom_to_list ,name)
"-transformer")))
(monad ,inner-monad)))
(defmacro do-m args
(let ((monad (car args))
(statements (cdr args)))

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

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

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

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

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

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

2
test/unit/unit-calrissian-state-monad-tests.lfe
View file

@ -9,4 +9,4 @@
(include-lib "include/monads.lfe")
(include-lib "include/monad-tests.lfe")
(test-monad 'calrissian-state-monad)
(test-monad (monad 'state))

14
test/unit/unit-calrissian-state-transformer-tests.lfe
View file

@ -9,23 +9,23 @@
(include-lib "include/monads.lfe")
(include-lib "include/monad-tests.lfe")
(test-monad (: calrissian-state-transformer new 'calrissian-identity-monad))
(test-monad (transformer 'state 'identity))
(deftest eval
(is-equal 5
(let* ((m (: calrissian-state-transformer new 'calrissian-identity-monad))
(let* ((m (transformer 'state 'identity))
(mval (call m 'return 5)))
(call m 'eval mval 'undefined))))
(deftest exec-unchanged
(is-equal 'foo
(let* ((m (: calrissian-state-transformer new 'calrissian-identity-monad))
(let* ((m (transformer 'state 'identity))
(mval (call m 'return 5)))
(call m 'exec mval 'foo))))
(deftest exec-modify
(is-equal 10
(let ((m (: calrissian-state-transformer new 'calrissian-identity-monad)))
(let ((m (transformer 'state 'identity)))
(call m 'exec
(do-m m
(call m 'modify (lambda (x) (* x 2))))
@ -33,7 +33,7 @@
(deftest exec-put-and-modify
(is-equal 30
(let ((m (: calrissian-state-transformer new 'calrissian-identity-monad)))
(let ((m (transformer 'state 'identity)))
(call m 'exec
(do-m m
(call m 'put 10)
@ -44,7 +44,7 @@
(deftest exec-bind-and-modify
(is-equal 16
(let ((m (: calrissian-state-transformer new 'calrissian-identity-monad)))
(let ((m (transformer 'state 'identity)))
(call m 'exec
(do-m m
(a <- (call m 'modify-and-return (lambda (x) (+ x 5))))
@ -53,7 +53,7 @@
(deftest exec-fail
(is-throw #(error value)
(let ((m (: calrissian-state-transformer new 'calrissian-identity-monad)))
(let ((m (transformer 'state 'identity)))
(call m 'exec
(call m 'fail 'value)
'undefined))))