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

fixup state transformer monad

Browse source
This commit is contained in:
Correl Roush 2014-05-13 19:31:15 -04:00
parent 02ada611df
commit 4db1e51ab7
2 changed files with 17 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
src/state-transformer.lfe
View file

@ -16,10 +16,10 @@
(lambda (_) (call inner-monad 'fail reason)))) (lambda (_) (call inner-monad 'fail reason))))
(defun >>= (defun >>=
((x f (tuple 'maybe-transformer inner-monad)) ((x f (tuple 'state-transformer inner-monad))
(lambda (s) (lambda (s)
(call inner-monad '>>= (call inner-monad '>>=
(funcall x f) (funcall x s)
(match-lambda (((tuple x1 s1)) (funcall (funcall f x1) s1))))))) (match-lambda (((tuple x1 s1)) (funcall (funcall f x1) s1)))))))
(defun get (_) (defun get (_)
@ -39,13 +39,15 @@
((m s (tuple 'state-transformer inner-monad)) ((m s (tuple 'state-transformer inner-monad))
(call inner-monad '>>= (call inner-monad '>>=
(funcall m s) (funcall m s)
(match-lambda (((tuple x s1)) x))))) (match-lambda (((tuple x s1))
(call inner-monad 'return x))))))
(defun exec (defun exec
((m s (tuple 'state-transformer inner-monad)) ((m s (tuple 'state-transformer inner-monad))
(call inner-monad '>>= (call inner-monad '>>=
(funcall m s) (funcall m s)
(match-lambda (((tuple x s1)) s1))))) (match-lambda (((tuple x s1))
(call inner-monad 'return s1))))))
(defun run (defun run
((m s (tuple 'state-transformer inner-monad)) ((m s (tuple 'state-transformer inner-monad))

15
test/unit/unit-state-transformer-tests.lfe
View file

@ -8,9 +8,6 @@
(include-lib "deps/lfeunit/include/lfeunit-macros.lfe") (include-lib "deps/lfeunit/include/lfeunit-macros.lfe")
(include-lib "include/monads.lfe") (include-lib "include/monads.lfe")
(deftestskip foo
(is 'false))
(deftest eval (deftest eval
(is-equal 5 (is-equal 5
(let* ((m (: state-transformer new 'identity-monad)) (let* ((m (: state-transformer new 'identity-monad))
@ -23,7 +20,7 @@
(mval (call m 'return 5))) (mval (call m 'return 5)))
(call m 'exec mval 'foo)))) (call m 'exec mval 'foo))))
(deftest exec-double (deftest exec-modify
(is-equal 10 (is-equal 10
(let ((m (: state-transformer new 'identity-monad))) (let ((m (: state-transformer new 'identity-monad)))
(call m 'exec (call m 'exec
@ -31,6 +28,16 @@
(call m 'modify (lambda (x) (* x 2)))) (call m 'modify (lambda (x) (* x 2))))
5)))) 5))))
(deftest exec-modify-multiple
(is-equal 30
(let ((m (: state-transformer new 'identity-monad)))
(call m 'exec
(do-m m
(call m 'modify (lambda (x) (+ x 5)))
(call m 'modify (lambda (x) (* x 2)))
(call m 'return 123))
10))))
(deftest exec-fail (deftest exec-fail
(is-throw #(error value) (is-throw #(error value)
(let ((m (: state-transformer new 'identity-monad))) (let ((m (: state-transformer new 'identity-monad)))