From 0b359cf2c32cde81b4311d55273c8f6c14ca6b93 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Tue, 2 Nov 2021 01:17:41 +0530 Subject: 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. (): 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 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. --- ccwl/ccwl.scm | 132 ++++++++++++++++++++++++++++++++++++++++++--------------- ccwl/cwl.scm | 2 + guix.scm | 28 +++++++++++- tests/ccwl.scm | 14 ++++++ 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 + (make-cwl-workflow file inputs outputs) + cwl-workflow? + (file cwl-workflow-file) + (inputs cwl-workflow-inputs) + (outputs cwl-workflow-outputs)) + (define-immutable-record-type (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 + ;; 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 +object or a 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 or +object." + ((cond + ((command? function) command-outputs) + ((cwl-workflow? function) cwl-workflow-outputs) + (else (error "Unrecognized ccwl function" function))) + function)) (define-immutable-record-type (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 or a +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 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 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 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 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") -- cgit v1.2.3