From d63f2df9d10ab425930900283323aba4b96b8a8c Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Fri, 1 Dec 2023 22:41:17 +0000
Subject: 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.
---
 ccwl/ccwl.scm   | 11 +++++++++--
 ccwl/utils.scm  | 19 -------------------
 tests/ccwl.scm  | 17 ++++++++++++++++-
 tests/utils.scm |  9 ---------
 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
-- 
cgit v1.2.3