diff --git a/include/monads.lfe b/include/monads.lfe index 6f1a197..b6be97d 100644 --- a/include/monads.lfe +++ b/include/monads.lfe @@ -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))) diff --git a/test/unit/unit-calrissian-error-monad-tests.lfe b/test/unit/unit-calrissian-error-monad-tests.lfe index 24bc78f..37003aa 100644 --- a/test/unit/unit-calrissian-error-monad-tests.lfe +++ b/test/unit/unit-calrissian-error-monad-tests.lfe @@ -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)))) diff --git a/test/unit/unit-calrissian-identity-monad-tests.lfe b/test/unit/unit-calrissian-identity-monad-tests.lfe index ed4e467..ea8ccac 100644 --- a/test/unit/unit-calrissian-identity-monad-tests.lfe +++ b/test/unit/unit-calrissian-identity-monad-tests.lfe @@ -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))) \ No newline at end of file + (fail (monad 'identity) 'value))) \ No newline at end of file diff --git a/test/unit/unit-calrissian-maybe-monad-tests.lfe b/test/unit/unit-calrissian-maybe-monad-tests.lfe index 1e1b09e..e463b49 100644 --- a/test/unit/unit-calrissian-maybe-monad-tests.lfe +++ b/test/unit/unit-calrissian-maybe-monad-tests.lfe @@ -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 diff --git a/test/unit/unit-calrissian-state-monad-tests.lfe b/test/unit/unit-calrissian-state-monad-tests.lfe index fe80e76..5081012 100644 --- a/test/unit/unit-calrissian-state-monad-tests.lfe +++ b/test/unit/unit-calrissian-state-monad-tests.lfe @@ -9,4 +9,4 @@ (include-lib "include/monads.lfe") (include-lib "include/monad-tests.lfe") -(test-monad 'calrissian-state-monad) +(test-monad (monad 'state)) diff --git a/test/unit/unit-calrissian-state-transformer-tests.lfe b/test/unit/unit-calrissian-state-transformer-tests.lfe index d6c693f..99e1c8a 100644 --- a/test/unit/unit-calrissian-state-transformer-tests.lfe +++ b/test/unit/unit-calrissian-state-transformer-tests.lfe @@ -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))))