mirror of
https://github.com/correl/calrissian.git
synced 2024-11-23 19:19:57 +00:00
Rename modules with calrissian- prefix
This commit is contained in:
parent
a45fda11a7
commit
0914cf5779
15 changed files with 79 additions and 79 deletions
|
@ -1,5 +1,5 @@
|
||||||
(defmacro evaluate-m (monad mval)
|
(defmacro evaluate-m (monad mval)
|
||||||
`(cond ((: calrissian-util implements? 'state ,monad)
|
`(cond ((: calrissian-util implements? 'calrissian-state ,monad)
|
||||||
(call ,monad 'run ,mval 'undefined))
|
(call ,monad 'run ,mval 'undefined))
|
||||||
('true ,mval)))
|
('true ,mval)))
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
(defmacro do-m args
|
(defmacro do-m args
|
||||||
(let ((monad (car args))
|
(let ((monad (car args))
|
||||||
(statements (cdr args)))
|
(statements (cdr args)))
|
||||||
(monad:do-transform monad statements)))
|
(calrissian-monad:do-transform monad statements)))
|
||||||
|
|
||||||
(defmacro >>= (monad m f)
|
(defmacro >>= (monad m f)
|
||||||
`(call ,monad '>>= ,m ,f))
|
`(call ,monad '>>= ,m ,f))
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
(defmodule error-monad
|
(defmodule calrissian-error-monad
|
||||||
(behaviour monad)
|
(behaviour calrissian-monad)
|
||||||
(export (>>= 2)
|
(export (>>= 2)
|
||||||
(return 1)
|
(return 1)
|
||||||
(fail 1)))
|
(fail 1)))
|
|
@ -1,5 +1,5 @@
|
||||||
(defmodule identity-monad
|
(defmodule calrissian-identity-monad
|
||||||
(behaviour monad)
|
(behaviour calrissian-monad)
|
||||||
(export (>>= 2)
|
(export (>>= 2)
|
||||||
(return 1)
|
(return 1)
|
||||||
(fail 1)))
|
(fail 1)))
|
|
@ -1,5 +1,5 @@
|
||||||
(defmodule maybe-monad
|
(defmodule calrissian-maybe-monad
|
||||||
(behaviour monad)
|
(behaviour calrissian-monad)
|
||||||
(export (>>= 2)
|
(export (>>= 2)
|
||||||
(return 1)
|
(return 1)
|
||||||
(fail 1)))
|
(fail 1)))
|
|
@ -1,4 +1,4 @@
|
||||||
(defmodule monad
|
(defmodule calrissian-monad
|
||||||
(export (behaviour_info 1)
|
(export (behaviour_info 1)
|
||||||
(do-transform 2)))
|
(do-transform 2)))
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
(defmodule state-monad
|
(defmodule calrissian-state-monad
|
||||||
(behaviour monad)
|
(behaviour calrissian-monad)
|
||||||
(behaviour state)
|
(behaviour calrissian-state)
|
||||||
(export (return 1)
|
(export (return 1)
|
||||||
(fail 1)
|
(fail 1)
|
||||||
(run 2)
|
(run 2)
|
|
@ -1,21 +1,21 @@
|
||||||
(defmodule state-transformer
|
(defmodule calrissian-state-transformer
|
||||||
(export all))
|
(export all))
|
||||||
|
|
||||||
(include-lib "include/monads.lfe")
|
(include-lib "include/monads.lfe")
|
||||||
|
|
||||||
(defun new (inner-monad)
|
(defun new (inner-monad)
|
||||||
(tuple 'state-transformer inner-monad))
|
(tuple 'calrissian-state-transformer inner-monad))
|
||||||
|
|
||||||
(defun return
|
(defun return
|
||||||
((x (tuple 'state-transformer inner-monad))
|
((x (tuple 'calrissian-state-transformer inner-monad))
|
||||||
(lambda (s) (call inner-monad 'return (tuple x s)))))
|
(lambda (s) (call inner-monad 'return (tuple x s)))))
|
||||||
|
|
||||||
(defun fail
|
(defun fail
|
||||||
((reason (tuple 'state-transformer inner-monad))
|
((reason (tuple 'calrissian-state-transformer inner-monad))
|
||||||
(lambda (_) (call inner-monad 'fail reason))))
|
(lambda (_) (call inner-monad 'fail reason))))
|
||||||
|
|
||||||
(defun >>=
|
(defun >>=
|
||||||
((x f (tuple 'state-transformer inner-monad))
|
((x f (tuple 'calrissian-state-transformer inner-monad))
|
||||||
(lambda (s)
|
(lambda (s)
|
||||||
(call inner-monad '>>=
|
(call inner-monad '>>=
|
||||||
(funcall x s)
|
(funcall x s)
|
||||||
|
@ -30,31 +30,31 @@
|
||||||
(tuple 'ok s)))
|
(tuple 'ok s)))
|
||||||
|
|
||||||
(defun modify
|
(defun modify
|
||||||
((f (tuple 'state-transformer inner-monad))
|
((f (tuple 'calrissian-state-transformer inner-monad))
|
||||||
(lambda (s)
|
(lambda (s)
|
||||||
(tuple 'ok (call inner-monad 'return (funcall f s))))))
|
(tuple 'ok (call inner-monad 'return (funcall f s))))))
|
||||||
|
|
||||||
(defun modify-and-return
|
(defun modify-and-return
|
||||||
((f (tuple 'state-transformer inner-monad))
|
((f (tuple 'calrissian-state-transformer inner-monad))
|
||||||
(lambda (s)
|
(lambda (s)
|
||||||
(let ((newstate (call inner-monad 'return (funcall f s))))
|
(let ((newstate (call inner-monad 'return (funcall f s))))
|
||||||
(tuple newstate newstate)))))
|
(tuple newstate newstate)))))
|
||||||
|
|
||||||
(defun eval
|
(defun eval
|
||||||
((m s (tuple 'state-transformer inner-monad))
|
((m s (tuple 'calrissian-state-transformer inner-monad))
|
||||||
(call inner-monad '>>=
|
(call inner-monad '>>=
|
||||||
(funcall m s)
|
(funcall m s)
|
||||||
(match-lambda (((tuple x s1))
|
(match-lambda (((tuple x s1))
|
||||||
(call inner-monad 'return x))))))
|
(call inner-monad 'return x))))))
|
||||||
|
|
||||||
(defun exec
|
(defun exec
|
||||||
((m s (tuple 'state-transformer inner-monad))
|
((m s (tuple 'calrissian-state-transformer inner-monad))
|
||||||
(call inner-monad '>>=
|
(call inner-monad '>>=
|
||||||
(funcall m s)
|
(funcall m s)
|
||||||
(match-lambda (((tuple x s1))
|
(match-lambda (((tuple x s1))
|
||||||
(call inner-monad 'return s1))))))
|
(call inner-monad 'return s1))))))
|
||||||
|
|
||||||
(defun run
|
(defun run
|
||||||
((m s (tuple 'state-transformer inner-monad))
|
((m s (tuple 'calrissian-state-transformer inner-monad))
|
||||||
(funcall m s)))
|
(funcall m s)))
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
(defmodule state
|
(defmodule calrissian-state
|
||||||
(export (behaviour_info 1)))
|
(export (behaviour_info 1)))
|
||||||
|
|
||||||
(defun behaviour_info
|
(defun behaviour_info
|
36
test/unit/unit-calrissian-error-monad-tests.lfe
Normal file
36
test/unit/unit-calrissian-error-monad-tests.lfe
Normal file
|
@ -0,0 +1,36 @@
|
||||||
|
(defmodule unit-calrissian-error-monad-tests
|
||||||
|
(export all)
|
||||||
|
(import
|
||||||
|
(from lfeunit-util
|
||||||
|
(check-failed-assert 2)
|
||||||
|
(check-wrong-assert-exception 2))))
|
||||||
|
|
||||||
|
(include-lib "deps/lfeunit/include/lfeunit-macros.lfe")
|
||||||
|
(include-lib "include/monads.lfe")
|
||||||
|
(include-lib "include/monad-tests.lfe")
|
||||||
|
|
||||||
|
(test-monad 'calrissian-error-monad)
|
||||||
|
|
||||||
|
(deftest return-ok
|
||||||
|
(is-equal 'ok
|
||||||
|
(return 'calrissian-error-monad 'ok)))
|
||||||
|
|
||||||
|
(deftest return-value
|
||||||
|
(is-equal #(ok 123)
|
||||||
|
(return 'calrissian-error-monad 123)))
|
||||||
|
|
||||||
|
(deftest fail-with-reason
|
||||||
|
(is-equal #(error reason)
|
||||||
|
(fail 'calrissian-error-monad '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))))
|
||||||
|
|
||||||
|
(deftest fail-short-circuits-error
|
||||||
|
(is-equal #(error something-bad)
|
||||||
|
(>> 'calrissian-error-monad
|
||||||
|
(fail 'calrissian-error-monad 'something-bad)
|
||||||
|
(throw 'error))))
|
|
@ -1,4 +1,4 @@
|
||||||
(defmodule unit-identity-monad-tests
|
(defmodule unit-calrissian-identity-monad-tests
|
||||||
(export all)
|
(export all)
|
||||||
(import
|
(import
|
||||||
(from lfeunit-util
|
(from lfeunit-util
|
||||||
|
@ -9,12 +9,12 @@
|
||||||
(include-lib "include/monads.lfe")
|
(include-lib "include/monads.lfe")
|
||||||
(include-lib "include/monad-tests.lfe")
|
(include-lib "include/monad-tests.lfe")
|
||||||
|
|
||||||
(test-monad 'identity-monad)
|
(test-monad 'calrissian-identity-monad)
|
||||||
|
|
||||||
(deftest identity
|
(deftest identity
|
||||||
(is-equal 'ok
|
(is-equal 'ok
|
||||||
(return 'identity-monad 'ok)))
|
(return 'calrissian-identity-monad 'ok)))
|
||||||
|
|
||||||
(deftest fail-with-error
|
(deftest fail-with-error
|
||||||
(is-throw #(error value)
|
(is-throw #(error value)
|
||||||
(fail 'identity-monad 'value)))
|
(fail 'calrissian-identity-monad 'value)))
|
|
@ -1,4 +1,4 @@
|
||||||
(defmodule unit-maybe-monad-tests
|
(defmodule unit-calrissian-maybe-monad-tests
|
||||||
(export all)
|
(export all)
|
||||||
(import
|
(import
|
||||||
(from lfeunit-util
|
(from lfeunit-util
|
||||||
|
@ -9,22 +9,22 @@
|
||||||
(include-lib "include/monads.lfe")
|
(include-lib "include/monads.lfe")
|
||||||
(include-lib "include/monad-tests.lfe")
|
(include-lib "include/monad-tests.lfe")
|
||||||
|
|
||||||
(test-monad 'maybe-monad)
|
(test-monad 'calrissian-maybe-monad)
|
||||||
|
|
||||||
(deftest nothing-short-circuits-value
|
(deftest nothing-short-circuits-value
|
||||||
(is-equal 'nothing
|
(is-equal 'nothing
|
||||||
(>>= 'maybe-monad 'nothing
|
(>>= 'calrissian-maybe-monad 'nothing
|
||||||
(lambda (x) (+ 5 x)))))
|
(lambda (x) (+ 5 x)))))
|
||||||
|
|
||||||
(deftest nothing-short-circuits-error
|
(deftest nothing-short-circuits-error
|
||||||
(is-equal 'nothing
|
(is-equal 'nothing
|
||||||
(>>= 'maybe-monad 'nothing
|
(>>= 'calrissian-maybe-monad 'nothing
|
||||||
(lambda (_) (error 'bad-func)))))
|
(lambda (_) (error 'bad-func)))))
|
||||||
|
|
||||||
(deftest fold-increment-value
|
(deftest fold-increment-value
|
||||||
(is-equal #(just 3)
|
(is-equal #(just 3)
|
||||||
(let ((minc (lambda (x) (return 'maybe-monad (+ 1 x))))
|
(let ((minc (lambda (x) (return 'calrissian-maybe-monad (+ 1 x))))
|
||||||
(bind (lambda (f m) (>>= 'maybe-monad m f))))
|
(bind (lambda (f m) (>>= 'calrissian-maybe-monad m f))))
|
||||||
(lists:foldr bind
|
(lists:foldr bind
|
||||||
#(just 0)
|
#(just 0)
|
||||||
(list minc
|
(list minc
|
|
@ -1,4 +1,4 @@
|
||||||
(defmodule unit-state-monad-tests
|
(defmodule unit-calrissian-state-monad-tests
|
||||||
(export all)
|
(export all)
|
||||||
(import
|
(import
|
||||||
(from lfeunit-util
|
(from lfeunit-util
|
||||||
|
@ -9,4 +9,4 @@
|
||||||
(include-lib "include/monads.lfe")
|
(include-lib "include/monads.lfe")
|
||||||
(include-lib "include/monad-tests.lfe")
|
(include-lib "include/monad-tests.lfe")
|
||||||
|
|
||||||
(test-monad 'state-monad)
|
(test-monad 'calrissian-state-monad)
|
|
@ -1,4 +1,4 @@
|
||||||
(defmodule unit-state-transformer-tests
|
(defmodule unit-calrissian-state-transformer-tests
|
||||||
(export all)
|
(export all)
|
||||||
(import
|
(import
|
||||||
(from lfeunit-util
|
(from lfeunit-util
|
||||||
|
@ -9,23 +9,23 @@
|
||||||
(include-lib "include/monads.lfe")
|
(include-lib "include/monads.lfe")
|
||||||
(include-lib "include/monad-tests.lfe")
|
(include-lib "include/monad-tests.lfe")
|
||||||
|
|
||||||
(test-monad (: state-transformer new 'identity-monad))
|
(test-monad (: calrissian-state-transformer new 'calrissian-identity-monad))
|
||||||
|
|
||||||
(deftest eval
|
(deftest eval
|
||||||
(is-equal 5
|
(is-equal 5
|
||||||
(let* ((m (: state-transformer new 'identity-monad))
|
(let* ((m (: calrissian-state-transformer new 'calrissian-identity-monad))
|
||||||
(mval (call m 'return 5)))
|
(mval (call m 'return 5)))
|
||||||
(call m 'eval mval 'undefined))))
|
(call m 'eval mval 'undefined))))
|
||||||
|
|
||||||
(deftest exec-unchanged
|
(deftest exec-unchanged
|
||||||
(is-equal 'foo
|
(is-equal 'foo
|
||||||
(let* ((m (: state-transformer new 'identity-monad))
|
(let* ((m (: calrissian-state-transformer new 'calrissian-identity-monad))
|
||||||
(mval (call m 'return 5)))
|
(mval (call m 'return 5)))
|
||||||
(call m 'exec mval 'foo))))
|
(call m 'exec mval 'foo))))
|
||||||
|
|
||||||
(deftest exec-modify
|
(deftest exec-modify
|
||||||
(is-equal 10
|
(is-equal 10
|
||||||
(let ((m (: state-transformer new 'identity-monad)))
|
(let ((m (: calrissian-state-transformer new 'calrissian-identity-monad)))
|
||||||
(call m 'exec
|
(call m 'exec
|
||||||
(do-m m
|
(do-m m
|
||||||
(call m 'modify (lambda (x) (* x 2))))
|
(call m 'modify (lambda (x) (* x 2))))
|
||||||
|
@ -33,7 +33,7 @@
|
||||||
|
|
||||||
(deftest exec-put-and-modify
|
(deftest exec-put-and-modify
|
||||||
(is-equal 30
|
(is-equal 30
|
||||||
(let ((m (: state-transformer new 'identity-monad)))
|
(let ((m (: calrissian-state-transformer new 'calrissian-identity-monad)))
|
||||||
(call m 'exec
|
(call m 'exec
|
||||||
(do-m m
|
(do-m m
|
||||||
(call m 'put 10)
|
(call m 'put 10)
|
||||||
|
@ -44,7 +44,7 @@
|
||||||
|
|
||||||
(deftest exec-bind-and-modify
|
(deftest exec-bind-and-modify
|
||||||
(is-equal 16
|
(is-equal 16
|
||||||
(let ((m (: state-transformer new 'identity-monad)))
|
(let ((m (: calrissian-state-transformer new 'calrissian-identity-monad)))
|
||||||
(call m 'exec
|
(call m 'exec
|
||||||
(do-m m
|
(do-m m
|
||||||
(a <- (call m 'modify-and-return (lambda (x) (+ x 5))))
|
(a <- (call m 'modify-and-return (lambda (x) (+ x 5))))
|
||||||
|
@ -53,7 +53,7 @@
|
||||||
|
|
||||||
(deftest exec-fail
|
(deftest exec-fail
|
||||||
(is-throw #(error value)
|
(is-throw #(error value)
|
||||||
(let ((m (: state-transformer new 'identity-monad)))
|
(let ((m (: calrissian-state-transformer new 'calrissian-identity-monad)))
|
||||||
(call m 'exec
|
(call m 'exec
|
||||||
(call m 'fail 'value)
|
(call m 'fail 'value)
|
||||||
'undefined))))
|
'undefined))))
|
|
@ -1,36 +0,0 @@
|
||||||
(defmodule unit-error-monad-tests
|
|
||||||
(export all)
|
|
||||||
(import
|
|
||||||
(from lfeunit-util
|
|
||||||
(check-failed-assert 2)
|
|
||||||
(check-wrong-assert-exception 2))))
|
|
||||||
|
|
||||||
(include-lib "deps/lfeunit/include/lfeunit-macros.lfe")
|
|
||||||
(include-lib "include/monads.lfe")
|
|
||||||
(include-lib "include/monad-tests.lfe")
|
|
||||||
|
|
||||||
(test-monad 'error-monad)
|
|
||||||
|
|
||||||
(deftest return-ok
|
|
||||||
(is-equal 'ok
|
|
||||||
(return 'error-monad 'ok)))
|
|
||||||
|
|
||||||
(deftest return-value
|
|
||||||
(is-equal #(ok 123)
|
|
||||||
(return 'error-monad 123)))
|
|
||||||
|
|
||||||
(deftest fail-with-reason
|
|
||||||
(is-equal #(error 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))))
|
|
||||||
|
|
||||||
(deftest fail-short-circuits-error
|
|
||||||
(is-equal #(error something-bad)
|
|
||||||
(>> 'error-monad
|
|
||||||
(fail 'error-monad 'something-bad)
|
|
||||||
(throw 'error))))
|
|
Loading…
Reference in a new issue