From 593c3fe600a5f5e90a6eea3a175f83d3319b4efe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 9 Dec 2013 21:10:28 +0100
Subject: [PATCH] monads: Fix 'anym'.
* guix/monads.scm (anym): Fix successful case.
* tests/monads.scm ("anym"): New test.
---
guix/monads.scm | 7 ++++---
tests/monads.scm | 12 ++++++++++++
2 files changed, 16 insertions(+), 3 deletions(-)
diff --git a/guix/monads.scm b/guix/monads.scm
index b62fc28a559..f5c9e8e9c7d 100644
--- a/guix/monads.scm
+++ b/guix/monads.scm
@@ -228,9 +228,10 @@ (define (anym monad proc lst)
(()
(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 7fc2aa90c1c..d3f78e15684 100644
--- a/tests/monads.scm
+++ b/tests/monads.scm
@@ -163,6 +163,18 @@ (define (frob i)
%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")
--
GitLab