aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2023-12-01 22:41:17 +0000
committerArun Isaac2023-12-01 22:54:33 +0000
commitd63f2df9d10ab425930900283323aba4b96b8a8c (patch)
tree0ddef6c50b0ae1ba77bb465674b83599dc842ba1
parentd5fadbd7d93fe047a37591a149bae007c359b88c (diff)
downloadccwl-d63f2df9d10ab425930900283323aba4b96b8a8c.tar.gz
ccwl-d63f2df9d10ab425930900283323aba4b96b8a8c.tar.lz
ccwl-d63f2df9d10ab425930900283323aba4b96b8a8c.zip
ccwl: Deduplicate global workflow input keys across tee branches.
* ccwl/ccwl.scm (collect-steps): Deduplicate global workflow input keys across branches of tees. * tests/ccwl.scm (key, collect-steps): New variables. ("rename should work even on the final output of a workflow"): Update order of elements in expected list. ("tee must deduplicate global workflow input keys"): New test. * ccwl/utils.scm (append-mapn): Delete function. * tests/utils.scm ("append-mapn"): Delete test.
-rw-r--r--ccwl/ccwl.scm11
-rw-r--r--ccwl/utils.scm19
-rw-r--r--tests/ccwl.scm17
-rw-r--r--tests/utils.scm9
4 files changed, 25 insertions, 31 deletions
diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm
index bbc5de1..743944d 100644
--- a/ccwl/ccwl.scm
+++ b/ccwl/ccwl.scm
@@ -636,8 +636,15 @@ represented by <step> objects."
(list)))
;; tee
((tee expressions ...)
- (append-mapn (cut collect-steps <> input-keys)
- #'(expressions ...)))
+ (let ((key-lists step-lists (mapn (cut collect-steps <> input-keys)
+ #'(expressions ...))))
+ (values
+ ;; Global workflow input keys may be duplicated across the
+ ;; branches of a tee. So, deduplicate them by treating key
+ ;; lists as sets. TODO: Error out if any keys other than
+ ;; global workflow inputs are duplicated.
+ (apply lset-union eq? key-lists)
+ (apply append step-lists))))
((identity)
(values input-keys (list)))
;; rename keys (base case)
diff --git a/ccwl/utils.scm b/ccwl/utils.scm
index d9d1ee3..3c18efd 100644
--- a/ccwl/utils.scm
+++ b/ccwl/utils.scm
@@ -39,7 +39,6 @@
lambda**
syntax-lambda**
mapn
- append-mapn
foldn
filter-mapi))
@@ -329,24 +328,6 @@ number of lists are returned. For example,
(call-with-values (cut proc x) list))
lst))))
-(define (append-mapn proc lst)
- "Map PROC over LST just as in mapn, but append the results
-together. PROC can return multiple values, in which case, an equal
-number of lists are returned.
-
-(append-mapn (lambda (n)
- (values (list n (expt n 2))
- (list n (expt n 3))))
- (iota 5))
-=> (0 0 1 1 2 4 3 9 4 16)
-=> (0 0 1 1 2 8 3 27 4 64)"
- (call-with-values (cut mapn proc lst)
- (lambda lists
- (apply values
- (map (lambda (lst)
- (apply append lst))
- lists)))))
-
(define (foldn proc lst . inits)
"Apply PROC to the elements of LST to build a result, and return
that result. PROC can return multiple values, in which case, an equal
diff --git a/tests/ccwl.scm b/tests/ccwl.scm
index 9e73c50..f0e2911 100644
--- a/tests/ccwl.scm
+++ b/tests/ccwl.scm
@@ -17,7 +17,9 @@
;;; along with ccwl. If not, see <https://www.gnu.org/licenses/>.
(use-modules (rnrs exceptions)
+ (srfi srfi-1)
(srfi srfi-64)
+ (srfi srfi-71)
(ccwl ccwl)
(ccwl conditions))
@@ -30,6 +32,12 @@
(define make-array-type
(@@ (ccwl ccwl) make-array-type))
+(define key
+ (@@ (ccwl ccwl) key))
+
+(define collect-steps
+ (@@ (ccwl ccwl) collect-steps))
+
(define-syntax construct-type-syntax-wrapper
(lambda (x)
(syntax-case x ()
@@ -133,7 +141,7 @@
#:outputs (printed-message #:type stdout)))
(test-equal "rename should work even on the final output of a workflow"
- (list 'out1 'printed-message)
+ (list 'printed-message 'out1)
(map output-id
(workflow-outputs
(workflow ((message1 #:type string)
@@ -315,4 +323,11 @@
'(command #:inputs (messages #:type (array string))
#:run "echo" (array messages #:separator foo))))
+(test-assert "tee must deduplicate global workflow input keys"
+ (let ((keys steps (collect-steps #'(tee (print #:message message)
+ (identity))
+ (list (key 'message)))))
+ (= (length (delete-duplicates keys eq?))
+ (length keys))))
+
(test-end "ccwl")
diff --git a/tests/utils.scm b/tests/utils.scm
index 66220cc..50c3396 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -197,15 +197,6 @@
(iota 5))))
(list squares cubes)))
-(test-equal "append-mapn"
- '((0 0 1 1 2 4 3 9 4 16)
- (0 0 1 1 2 8 3 27 4 64))
- (let ((squares cubes (append-mapn (lambda (n)
- (values (list n (expt n 2))
- (list n (expt n 3))))
- (iota 5))))
- (list squares cubes)))
-
(test-equal "foldn"
'(45 285)
(let ((sum sum-of-squares