diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2013-12-09 21:10:28 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2013-12-10 00:24:01 +0100 |
| commit | 593c3fe600a5f5e90a6eea3a175f83d3319b4efe (patch) | |
| tree | 616bf04c694dd5dc540341fa11f1aac9c00952c2 | |
| parent | f7faff88b73c53fd1a8644dfb93e9214f4afaa9c (diff) | |
| download | patches-593c3fe600a5f5e90a6eea3a175f83d3319b4efe.tar patches-593c3fe600a5f5e90a6eea3a175f83d3319b4efe.tar.gz | |
monads: Fix 'anym'.
* guix/monads.scm (anym): Fix successful case.
* tests/monads.scm ("anym"): New test.
| -rw-r--r-- | guix/monads.scm | 7 | ||||
| -rw-r--r-- | tests/monads.scm | 12 |
2 files changed, 16 insertions, 3 deletions
diff --git a/guix/monads.scm b/guix/monads.scm index b62fc28a55..f5c9e8e9c7 100644 --- a/guix/monads.scm +++ b/guix/monads.scm @@ -228,9 +228,10 @@ lifted in MONAD, for which PROC returns true." (() (return #f)) ((head tail ...) - (mlet monad ((value head)) - (or (and=> (proc value) return) - head + (mlet* monad ((value head) + (result -> (proc value))) + (if result + (return result) (loop tail)))))))) (define-syntax listm diff --git a/tests/monads.scm b/tests/monads.scm index 7fc2aa90c1..d3f78e1568 100644 --- a/tests/monads.scm +++ b/tests/monads.scm @@ -163,6 +163,18 @@ %monads %monad-run)) +(test-assert "anym" + (every (lambda (monad run) + (eq? (run (with-monad monad + (let ((lst (list (return 1) (return 2) (return 3)))) + (anym monad + (lambda (x) + (and (odd? x) 'odd!)) + lst)))) + 'odd!)) + %monads + %monad-run)) + (test-end "monads") |