aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2021-11-02 01:17:41 +0530
committerArun Isaac2021-11-02 01:31:56 +0530
commit0b359cf2c32cde81b4311d55273c8f6c14ca6b93 (patch)
tree50def438dc8033db14804f33a2aef7fcffa2d9ec
parent179925c5d88ae38bc28baf470d350461d49ebede (diff)
downloadccwl-0b359cf2c32cde81b4311d55273c8f6c14ca6b93.tar.gz
ccwl-0b359cf2c32cde81b4311d55273c8f6c14ca6b93.tar.lz
ccwl-0b359cf2c32cde81b4311d55273c8f6c14ca6b93.zip
ccwl: Support external CWL workflows.
* ccwl/ccwl.scm: Import (yaml). Export cwl-workflow?, cwl-workflow, cwl-workflow-file, cwl-workflow-inputs and cwl-workflow-outputs. (<cwl-workflow>): New type. (cwl-workflow, function-input-keys, function-outputs, function-object): New functions. (command-input-keys, command-object): Delete functions. (collect-steps): Replace command-object with function-object, command-input-keys with function-input-keys and command-outputs with function-outputs. * ccwl/cwl.scm (workflow->cwl-scm): Handle <cwl-workflow> objects. * tests/ccwl.scm ("read all forms of inputs and outputs from a CWL workflow"): New test. * guix.scm: Import (gnu packages guile-xyz) and (guix utils). (guile-libyaml): New variable. (ccwl)[inputs]: Add guile-libyaml.
-rw-r--r--ccwl/ccwl.scm132
-rw-r--r--ccwl/cwl.scm2
-rw-r--r--guix.scm28
-rw-r--r--tests/ccwl.scm14
4 files changed, 139 insertions, 37 deletions
diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm
index 626a80e..8faf97e 100644
--- a/ccwl/ccwl.scm
+++ b/ccwl/ccwl.scm
@@ -31,7 +31,7 @@
#:use-module (srfi srfi-71)
#:use-module (ice-9 match)
#:use-module (ccwl utils)
- #:use-module (ccwl yaml)
+ #:use-module (yaml)
#:export (command?
command
command-inputs
@@ -39,6 +39,11 @@
command-args
command-stdin
command-other
+ cwl-workflow?
+ cwl-workflow
+ cwl-workflow-file
+ cwl-workflow-inputs
+ cwl-workflow-outputs
workflow
workflow?
workflow-steps
@@ -133,6 +138,13 @@
(stdin command-stdin)
(other command-other))
+(define-immutable-record-type <cwl-workflow>
+ (make-cwl-workflow file inputs outputs)
+ cwl-workflow?
+ (file cwl-workflow-file)
+ (inputs cwl-workflow-inputs)
+ (outputs cwl-workflow-outputs))
+
(define-immutable-record-type <workflow>
(make-workflow steps inputs outputs other)
workflow?
@@ -213,13 +225,61 @@ RUN-ARGS. If such an input is not present in RUN-ARGS, return #f."
(list #,@other)))
#'(args ...))))))
+(define (cwl-workflow file)
+ (define (parameters->id+type parameters)
+ (if (vector? parameters)
+ ;; Vector of dictionaries
+ (map (lambda (alist)
+ (cons (string->symbol (assoc-ref alist "id"))
+ (string->symbol (assoc-ref alist "type"))))
+ (vector->list parameters))
+ ;; One dictionary
+ (map (match-lambda
+ ((id . (? string? type))
+ (cons (string->symbol id)
+ (string->symbol type)))
+ ((id . alist)
+ (cons (string->symbol id)
+ (string->symbol (assoc-ref alist "type")))))
+ parameters)))
+
+ (unless (file-exists? file)
+ (error "CWL workflow file does not exist" file))
+ ;; Read inputs/outputs from CWL workflow YAML file and build a
+ ;; <cwl-workflow> object.
+ (let ((yaml (read-yaml-file file)))
+ (make-cwl-workflow file
+ (map (match-lambda
+ ((id . type)
+ (make-input id type #f #f #f #f #f)))
+ (parameters->id+type (assoc-ref yaml "inputs")))
+ (map (match-lambda
+ ((id . type)
+ (make-output id type #f #f #f)))
+ (parameters->id+type (assoc-ref yaml "outputs"))))))
+
(define (input=? input1 input2)
(eq? (input-id input1)
(input-id input2)))
-(define (command-input-keys command)
- "Return the list of input keys accepted by COMMAND."
- (map input-id (command-inputs command)))
+(define (function-input-keys function)
+ "Return the list of input keys accepted by FUNCTION, a <command>
+object or a <cwl-workflow> object."
+ (map input-id
+ ((cond
+ ((command? function) command-inputs)
+ ((cwl-workflow? function) cwl-workflow-inputs)
+ (else (error "Unrecognized ccwl function" function)))
+ function)))
+
+(define (function-outputs function)
+ "Return the outputs of FUNCTION, a <command> or <cwl-workflow>
+object."
+ ((cond
+ ((command? function) command-outputs)
+ ((cwl-workflow? function) cwl-workflow-outputs)
+ (else (error "Unrecognized ccwl function" function)))
+ function))
(define-immutable-record-type <key>
(make-key name cwl-id step)
@@ -241,13 +301,15 @@ RUN-ARGS. If such an input is not present in RUN-ARGS, return #f."
;; Global input/output
(symbol->string (key-cwl-id key))))
-(define (command-object command-syntax)
- "Return the command object described by COMMAND-SYNTAX. If such a
-command is not defined, return #f."
+(define (function-object x)
+ "Return the ccwl function object (a <command> or a <cwl-workflow>
+object) described by syntax X. If such a ccwl function is not defined,
+return #f."
(let ((var (module-variable (current-module)
- (syntax->datum command-syntax))))
+ (syntax->datum x))))
(and var
- (command? (variable-ref var))
+ (or (command? (variable-ref var))
+ (cwl-workflow? (variable-ref var)))
(variable-ref var))))
(define (collect-steps x input-keys)
@@ -279,35 +341,35 @@ represented by <step> objects."
key))
input-keys)
(list)))
- ;; commands with only a single input when only a single key is
- ;; available at this step and when no inputs are passed to it
- ((command (step-id))
- (and (command-object #'command)
+ ;; ccwl functions with only a single input when only a single key
+ ;; is available at this step and when no inputs are passed to it
+ ((function (step-id))
+ (and (function-object #'function)
(= (length input-keys) 1)
- (= (length (command-input-keys
- (command-object #'command)))
+ (= (length (function-input-keys
+ (function-object #'function)))
1))
- (collect-steps #`(command (step-id)
- #,(match (command-input-keys
- (command-object #'command))
- ((command-key) (symbol->keyword command-key)))
- #,(match input-keys
- ((input-key) (key-name input-key))))
+ (collect-steps #`(function (step-id)
+ #,(match (function-input-keys
+ (function-object #'function))
+ ((command-key) (symbol->keyword command-key)))
+ #,(match input-keys
+ ((input-key) (key-name input-key))))
input-keys))
- ((command (step-id) args ...)
+ ((function (step-id) args ...)
;; Run a whole bunch of tests so that we can produce useful error
;; messages.
(let ((input-key-symbols (map key-name input-keys))
- (command-object (command-object #'command))
+ (function-object (function-object #'function))
(step-id (syntax->datum #'step-id)))
;; Test for undefined command.
- (unless command-object
- (error "Undefined ccwl command:" (syntax->datum #'command)))
+ (unless function-object
+ (error "Undefined ccwl command:" (syntax->datum #'function)))
;; Test for missing required parameters.
;; TODO: Filter out optional parameters.
(match (lset-difference
eq?
- (command-input-keys command-object)
+ (function-input-keys function-object)
(map (match-lambda
((key . _) (keyword->symbol key)))
(syntax->datum (pairify #'(args ...)))))
@@ -322,13 +384,13 @@ represented by <step> objects."
(for-each (match-lambda
((arg . value)
(unless (memq (keyword->symbol arg)
- (command-input-keys command-object))
+ (function-input-keys function-object))
(scm-error 'misc-error
#f
"ccwl command `~S' does not accept input key `~S'. Accepted keys are `~S'."
- (list (syntax->datum #'command)
+ (list (syntax->datum #'ccwl-function)
arg
- (command-input-keys command-object))
+ (function-input-keys function-object))
#f))
(unless (memq value input-key-symbols)
(scm-error 'misc-error
@@ -340,9 +402,9 @@ represented by <step> objects."
(values (append (remove key-step input-keys)
(map (lambda (output)
(key (output-id output) step-id))
- (command-outputs command-object)))
+ (function-outputs function-object)))
(list (make-step step-id
- command-object
+ function-object
(map (match-lambda
((arg . value)
(cons (keyword->symbol arg)
@@ -351,10 +413,10 @@ represented by <step> objects."
(eq? value (key-name key)))
input-keys)))))
(pairify (syntax->datum #'(args ...))))
- (command-outputs command-object))))))
- ;; commands with an implicit step identifier
- ((command args ...)
- (collect-steps #'(command (command) args ...)
+ (function-outputs function-object))))))
+ ;; ccwl functions with an implicit step identifier
+ ((function args ...)
+ (collect-steps #'(function (function) args ...)
input-keys))
;; any other unrecognized syntax
(x (error "Unrecognized syntax:" (syntax->datum #'x)))))
diff --git a/ccwl/cwl.scm b/ccwl/cwl.scm
index 47b30da..e4d03bc 100644
--- a/ccwl/cwl.scm
+++ b/ccwl/cwl.scm
@@ -86,6 +86,8 @@ association list."
(run . ,(match (step-run step)
((? command? command)
(command->cwl-scm command))
+ ((? cwl-workflow? cwl-workflow)
+ (cwl-workflow-file cwl-workflow))
(tree tree)))))
(workflow-steps workflow)))))
diff --git a/guix.scm b/guix.scm
index 9339da0..78d7c41 100644
--- a/guix.scm
+++ b/guix.scm
@@ -31,6 +31,7 @@
(gnu packages bioinformatics)
(gnu packages graphviz)
(gnu packages guile)
+ ((gnu packages guile-xyz) #:prefix guix:)
(gnu packages pkg-config)
(gnu packages skribilo)
(gnu packages texinfo)
@@ -38,10 +39,32 @@
(guix gexp)
(guix git-download)
(guix packages)
- ((guix licenses) #:prefix license:))
+ ((guix licenses) #:prefix license:)
+ (guix utils))
(define %source-dir (dirname (current-filename)))
+;; The upstream Guix guile-libyaml package is broken. Fix it
+;; temporarily here.
+(define guile-libyaml
+ (package
+ (inherit guix:guile-libyaml)
+ (arguments
+ (substitute-keyword-arguments (package-arguments guix:guile-libyaml)
+ ((#:phases phases)
+ `(modify-phases ,phases
+ (replace 'remove-unused-files
+ (lambda _
+ (for-each delete-file
+ (list "guix.scm" "demo1.scm" "demo1.yml"))))
+ (replace 'build-ffi
+ (lambda* (#:key inputs #:allow-other-keys)
+ (substitute* "yaml/libyaml.scm"
+ (("dynamic-link \"libyaml\"")
+ (string-append "dynamic-link \""
+ (assoc-ref inputs "libyaml")
+ "/lib/libyaml\"")))))))))))
+
(define ccwl
(package
(name "ccwl")
@@ -53,7 +76,8 @@
(arguments
'(#:make-flags '("GUILE_AUTO_COMPILE=0"))) ; to prevent guild warnings
(inputs
- `(("guile" ,guile-3.0)))
+ `(("guile" ,guile-3.0)
+ ("guile-libyaml" ,guile-libyaml)))
(native-inputs
`(("autoconf" ,autoconf)
("automake" ,automake)
diff --git a/tests/ccwl.scm b/tests/ccwl.scm
index 8f09fea..5d8a17f 100644
--- a/tests/ccwl.scm
+++ b/tests/ccwl.scm
@@ -34,4 +34,18 @@
'file)
'inputBinding)))
+(test-equal "read all forms of inputs and outputs from a CWL workflow"
+ '(((spam string))
+ ((ham stdout)
+ (eggs stdout)))
+ (let ((cwl-workflow (cwl-workflow "tests/input-output-parameters.cwl")))
+ (list (map (lambda (input)
+ (list (input-id input)
+ (input-type input)))
+ (cwl-workflow-inputs cwl-workflow))
+ (map (lambda (output)
+ (list (output-id output)
+ (output-type output)))
+ (cwl-workflow-outputs cwl-workflow)))))
+
(test-end "ccwl")