From 2853ef38886e3ffd7f12252ab17fb2d4e29614e2 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Tue, 17 Oct 2023 19:16:50 +0100
Subject: ccwl: Support staging input files.

* ccwl/ccwl.scm (<input>)[stage?]: New field.
* ccwl/ccwl.scm (input): Add #:stage argument.
* ccwl/cwl.scm (command->cwl-scm): Serialize requirements for staged
inputs.
* doc/ccwl.skb (Cookbook)[Stage input files]: New section.
* tests/ccwl.scm ("inputs with an invalid #:stage? parameter must
raise a &ccwl-violation condition"): New test.
---
 ccwl/ccwl.scm | 16 ++++++++++++----
 ccwl/cwl.scm  | 15 ++++++++++++++-
 2 files changed, 26 insertions(+), 5 deletions(-)

(limited to 'ccwl')

diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm
index fc6a152..98bc8ae 100644
--- a/ccwl/ccwl.scm
+++ b/ccwl/ccwl.scm
@@ -64,6 +64,7 @@
             input-default
             input-position
             input-prefix
+            input-stage?
             input-other
             output?
             output-id
@@ -79,7 +80,7 @@
             unspecified-default?))
 
 (define-immutable-record-type <input>
-  (make-input id type label default position prefix other)
+  (make-input id type label default position prefix stage? other)
   input?
   (id input-id)
   (type input-type)
@@ -87,6 +88,7 @@
   (default input-default set-input-default)
   (position input-position set-input-position)
   (prefix input-prefix set-input-prefix)
+  (stage? input-stage?)
   (other input-other))
 
 (define-immutable-record-type <unspecified-default>
@@ -127,14 +129,20 @@
                  (()
                   (condition (ccwl-violation input-spec)
                              (formatted-message "Input has no identifier")))))))
-       (apply (syntax-lambda** (id #:key (type #'File) label (default (make-unspecified-default)) (other #''()))
+       (apply (syntax-lambda** (id #:key (type #'File) label (default (make-unspecified-default)) (stage? #'#f) (other #''()))
+                (unless (memq (syntax->datum stage?)
+                              (list #t #f))
+                  (raise-exception
+                   (condition (ccwl-violation stage?)
+                              (formatted-message "Invalid #:stage? parameter ~a. #:stage? must either be #t or #f."
+                                                 (syntax->datum stage?)))))
                 (let ((position #f)
                       (prefix #f))
                   #`(make-input '#,id '#,type #,label
                                 #,(if (unspecified-default? default)
                                       #'(make-unspecified-default)
                                       default)
-                                #,position #,prefix #,other)))
+                                #,position #,prefix #,stage? #,other)))
               #'(id args ...))))
     (id (identifier? #'id) (input #'(id)))
     (_ (error "Invalid input:" (syntax->datum input-spec)))))
@@ -413,7 +421,7 @@ identifiers defined in the commands."
     (make-cwl-workflow file
                        (map (match-lambda
                               ((id . type)
-                               (make-input id type #f #f #f #f #f)))
+                               (make-input id type #f #f #f #f #f #f)))
                             (parameters->id+type (assoc-ref yaml "inputs")))
                        (map (match-lambda
                               ((id . type)
diff --git a/ccwl/cwl.scm b/ccwl/cwl.scm
index 6c28175..f5d7f6a 100644
--- a/ccwl/cwl.scm
+++ b/ccwl/cwl.scm
@@ -24,6 +24,7 @@
 ;;; Code:
 
 (define-module (ccwl cwl)
+  #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:use-module (ccwl ccwl)
   #:use-module (ccwl utils)
@@ -120,7 +121,19 @@ CWL YAML specification."
   "Render COMMAND, a <command> object, into a CWL tree."
   `((cwlVersion . ,%cwl-version)
     (class . CommandLineTool)
-    (requirements . ,(command-requirements command))
+    (requirements
+     ,@(if (any input-stage? (command-inputs command))
+           ;; Stage any inputs that need to be.
+           `((InitialWorkDirRequirement
+              (listing . ,(list->vector
+                           (filter-map (lambda (input)
+                                         (and (input-stage? input)
+                                              (string-append "$(inputs."
+                                                             (symbol->string (input-id input))
+                                                             ")")))
+                                       (command-inputs command))))))
+           '())
+     ,@(command-requirements command))
     ,@(command-other command)
     (arguments . ,(list->vector
                    ;; Put string arguments into the arguments array.
-- 
cgit v1.2.3