From 4ec1a9897d1c3e3ca69260b7eb4134e01c8c5794 Mon Sep 17 00:00:00 2001 From: Correl Roush Date: Tue, 13 May 2014 19:40:37 -0400 Subject: [PATCH] wip: modify-and-return --- src/state-transformer.lfe | 5 +++++ test/unit/unit-state-transformer-tests.lfe | 14 ++++++++++++-- 2 files changed, 17 insertions(+), 2 deletions(-) diff --git a/src/state-transformer.lfe b/src/state-transformer.lfe index 2f1659b..e636f06 100644 --- a/src/state-transformer.lfe +++ b/src/state-transformer.lfe @@ -35,6 +35,11 @@ (lambda (s) (tuple 'ok (call inner-monad 'return (funcall f s)))))) +(defun modify-and-return + ((f (tuple 'state-transformer inner-monad)) + (lambda (s) + (call inner-monad 'return (funcall f s))))) + (defun eval ((m s (tuple 'state-transformer inner-monad)) (call inner-monad '>>= diff --git a/test/unit/unit-state-transformer-tests.lfe b/test/unit/unit-state-transformer-tests.lfe index abf65be..f678978 100644 --- a/test/unit/unit-state-transformer-tests.lfe +++ b/test/unit/unit-state-transformer-tests.lfe @@ -28,15 +28,25 @@ (call m 'modify (lambda (x) (* x 2)))) 5)))) -(deftest exec-modify-multiple +(deftest exec-put-and-modify (is-equal 30 (let ((m (: state-transformer new 'identity-monad))) (call m 'exec (do-m m + (call m 'put 10) (call m 'modify (lambda (x) (+ x 5))) (call m 'modify (lambda (x) (* x 2))) (call m 'return 123)) - 10)))) + 3)))) + +(deftest exec-bind-and-modify + (is-equal 16 + (let ((m (: state-transformer new 'identity-monad))) + (call m 'exec + (do-m m + (a <- (call m 'modify-and-return (lambda (x) (+ x 5)))) + (call m 'modify (lambda (x) (+ x a)))) + 3)))) (deftest exec-fail (is-throw #(error value)