From 21d03fb536e7f2193cccf9b58d4fc8aac2fd91cb Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Thu, 5 Dec 2024 00:22:24 +0000
Subject: bin: Add --output-directory argument.
* bin/ravanan: Import (ravanan work utils).
(%options): Add --output-directory.
(print-usage): Document it.
(symlink-to-output-directory): New function.
(main): Symlink to output directory if it is specified.
---
bin/ravanan | 163 ++++++++++++++++++++++++++++++++++++++++--------------------
1 file changed, 109 insertions(+), 54 deletions(-)
(limited to 'bin')
diff --git a/bin/ravanan b/bin/ravanan
index bf27fe9..f47e7b9 100755
--- a/bin/ravanan
+++ b/bin/ravanan
@@ -33,7 +33,8 @@ exec guile --no-auto-compile -e main -s "$0" "$@"
(ravanan config)
(ravanan reader)
(ravanan utils)
- (ravanan workflow))
+ (ravanan workflow)
+ (ravanan work utils))
(define %options
(list (option (list "batch-system" "batchSystem") #t #f
@@ -70,6 +71,12 @@ exec guile --no-auto-compile -e main -s "$0" "$@"
(lambda (opt name arg result)
(acons 'slurm-nice (string->number arg)
result)))
+ ;; The shorter outdir form is to maintain compatibility with cwltool and
+ ;; cwltest.
+ (option (list "output-directory" "outdir") #t #f
+ (lambda (opt name arg result)
+ (acons 'outdir arg
+ result)))
(option (list "help") #f #t
(lambda (opt name arg result)
(acons 'help #t result)))
@@ -85,6 +92,8 @@ exec guile --no-auto-compile -e main -s "$0" "$@"
"Usage: ~a [OPTIONS] CWL-WORKFLOW INPUTS
Run CWL-WORKFLOW with INPUTS.
+ --output-directory=DIRECTORY
+ --outdir=DIRECTORY output directory
--version print version and exit
--batch-system=BATCH-SYSTEM batch system to run jobs on;
@@ -119,6 +128,46 @@ files that have the token in the @verbatim{SLURM_JWT=token} format."
string-trim-both
get-string-all)))
+(define (symlink-to-output-directory store output-directory tree)
+ "Symlink @code{File} or @code{Directory} type objects in JSON @var{tree} from the
+@var{store} into @var{output-directory}. Return @var{tree} with updated
+@code{path} properties."
+ (cond
+ ;; Array
+ ((vector? tree)
+ (vector-map (cut symlink-to-output-directory store output-directory <>)
+ tree))
+ ;; Object
+ ((list? tree)
+ ;; We cannot use object-type to determine the type since it would error out
+ ;; when it cannot determine the type.
+ (if (member (assoc-ref tree "class")
+ (list "File" "Directory"))
+ ;; If File or Directory, symlink it to output directory, and update
+ ;; path.
+ (let ((output-directory-path
+ (match (file-name-split
+ (relative-file-name (assoc-ref tree "path")
+ (expand-file-name %store-files-directory
+ store)))
+ ((_ parts ...)
+ (expand-file-name (file-name-join parts)
+ output-directory)))))
+ ;; Symlink file or directory to output directory.
+ (symlink (assoc-ref tree "path")
+ output-directory-path)
+ ;; Update path.
+ (assoc-set tree
+ (cons "path" output-directory-path)))
+ ;; Else, recurse.
+ (map (match-lambda
+ ((key . value)
+ (cons key
+ (symlink-to-output-directory store output-directory value))))
+ tree)))
+ ;; Atom
+ (else tree)))
+
(define main
(match-lambda
((program args ...)
@@ -155,57 +204,63 @@ files that have the token in the @verbatim{SLURM_JWT=token} format."
((workflow-file inputs-file)
;; We must not try to compile guix manifest files.
(set! %load-should-auto-compile #f)
- (scm->json (guard (c ((manifest-file-error? c)
- ;; Steps may provide their own
- ;; SoftwareRequirement. So, at this point, we do
- ;; not know if a manifest file is required and
- ;; can't check for these manifest file errors
- ;; right away. Instead, we depend on exceptions
- ;; bubbled up from lower down the stack.
- (let ((file (manifest-file-error-file c)))
- (cond
- ((not file)
- (error "--guix-manifest not specified"))
- ((not (file-exists? file))
- (error "Manifest file ~a does not exist"
- file))
- (else
- (error "Error loading manifest file"
- file)
- (raise-exception c))))))
- (run-workflow (file-name-stem workflow-file)
- (and (assq 'guix-manifest-file args)
- (canonicalize-path
- (assq-ref args 'guix-manifest-file)))
- (and (assq-ref args 'guix-channels-file)
- (load-script
- (canonicalize-path
- (assq-ref args 'guix-channels-file))
- #:modules '((guile)
- (guix channels))))
- (read-workflow workflow-file)
- (read-inputs inputs-file)
- (case (assq-ref args 'batch-system)
- ((single-machine)
- (or (assq-ref args 'scratch)
- (getcwd)))
- ((slurm-api)
- (assq-ref args 'scratch)))
- ;; FIXME: This is a bit of a hack to
- ;; avoid canonizing remote paths.
- (if (file-name-absolute? (assq-ref args 'store))
- (assq-ref args 'store)
- (canonicalize-path (assq-ref args 'store)))
- (case (assq-ref args 'batch-system)
- ((single-machine) 'single-machine)
- ((slurm-api)
- (slurm-api-batch-system
- (assq-ref args 'slurm-api-endpoint)
- (and (assq-ref args 'slurm-jwt)
- (read-jwt (assq-ref args 'slurm-jwt)))
- (assq-ref args 'slurm-partition)
- (assq-ref args 'slurm-nice))))
- #:guix-daemon-socket (assq-ref args 'guix-daemon-socket)))
- (current-output-port)
- #:pretty #t)
+ (let* ( ;; FIXME: This is a bit of a hack to avoid canonizing remote
+ ;; paths.
+ (store (if (file-name-absolute? (assq-ref args 'store))
+ (assq-ref args 'store)
+ (canonicalize-path (assq-ref args 'store))))
+ (outputs (guard (c ((manifest-file-error? c)
+ ;; Steps may provide their own
+ ;; SoftwareRequirement. So, at this point, we do
+ ;; not know if a manifest file is required and
+ ;; can't check for these manifest file errors
+ ;; right away. Instead, we depend on exceptions
+ ;; bubbled up from lower down the stack.
+ (let ((file (manifest-file-error-file c)))
+ (cond
+ ((not file)
+ (error "--guix-manifest not specified"))
+ ((not (file-exists? file))
+ (error "Manifest file ~a does not exist"
+ file))
+ (else
+ (error "Error loading manifest file"
+ file)
+ (raise-exception c))))))
+ (run-workflow (file-name-stem workflow-file)
+ (and (assq 'guix-manifest-file args)
+ (canonicalize-path
+ (assq-ref args 'guix-manifest-file)))
+ (and (assq-ref args 'guix-channels-file)
+ (load-script
+ (canonicalize-path
+ (assq-ref args 'guix-channels-file))
+ #:modules '((guile)
+ (guix channels))))
+ (read-workflow workflow-file)
+ (read-inputs inputs-file)
+ (case (assq-ref args 'batch-system)
+ ((single-machine)
+ (or (assq-ref args 'scratch)
+ (getcwd)))
+ ((slurm-api)
+ (assq-ref args 'scratch)))
+ store
+ (case (assq-ref args 'batch-system)
+ ((single-machine) 'single-machine)
+ ((slurm-api)
+ (slurm-api-batch-system
+ (assq-ref args 'slurm-api-endpoint)
+ (and (assq-ref args 'slurm-jwt)
+ (read-jwt (assq-ref args 'slurm-jwt)))
+ (assq-ref args 'slurm-partition)
+ (assq-ref args 'slurm-nice))))
+ #:guix-daemon-socket (assq-ref args 'guix-daemon-socket)))))
+ (scm->json (if (assq-ref args 'outdir)
+ (symlink-to-output-directory store
+ (assq-ref args 'outdir)
+ outputs)
+ outputs)
+ (current-output-port)
+ #:pretty #t))
(newline (current-output-port))))))))
--
cgit v1.2.3