From 9a354d0b99da83f60ab68f0151d6f0d5488b7a93 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Mon, 11 Oct 2021 14:40:42 +0530 Subject: ccwl: Factorize out CWL generation code to separate file. This factorization is required to support other compilation targets such as graphviz, bash, scheme, etc. * ccwl/cwl.scm: New file. * Makefile.am (SOURCES): Register it. * ccwl/ccwl.scm (ccwl): Export command?, command-inputs, command-outputs, command-args, command-stdin, command-other, workflow?, workflow-steps, workflow-inputs, workflow-outputs, workflow-other, input?, input-id, input-type, input-label, input-default, input-position, input-prefix, input-other, output?, output-id, output-type, output-binding, output-source, output-other, step?, step-id, step-run, step-in, step-out, unspecified-default?. (): New type. (filter-alist): Move to cwl.scm. (make-workflow): Refactor into workflow->cwl-scm in cwl.scm. (output->cwl): Move to cwl.scm as output->cwl-scm. (command->cwl): Move to cwl.scm as command->cwl-scm. (workflow-steps): Rename to collect-steps. Clarify docstring. (workflow): Use collect-steps instead of workflow-steps. Explicitly pass empty list as other argument of make-workflow. Add TODO note to implement it properly. * scripts/ccwl.in: Import (ccwl cwl) instead of (ccwl yaml). Use workflow->cwl instead of scm->yaml. * tests/ccwl.scm ("stdin input should not have inputBinding"): Use command->cwl-scm from (ccwl cwl) instead of command->cwl from (ccwl ccwl). --- Makefile.am | 2 +- ccwl/ccwl.scm | 167 +++++++++++++++++++------------------------------------- ccwl/cwl.scm | 132 ++++++++++++++++++++++++++++++++++++++++++++ scripts/ccwl.in | 6 +- tests/ccwl.scm | 4 +- 5 files changed, 195 insertions(+), 116 deletions(-) create mode 100644 ccwl/cwl.scm diff --git a/Makefile.am b/Makefile.am index 2434239..d143f48 100644 --- a/Makefile.am +++ b/Makefile.am @@ -73,7 +73,7 @@ godir = $(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache bin_SCRIPTS = scripts/ccwl -SOURCES = ccwl/ccwl.scm ccwl/yaml.scm ccwl/utils.scm +SOURCES = ccwl/ccwl.scm ccwl/cwl.scm ccwl/yaml.scm ccwl/utils.scm TEST_EXTENSIONS = .scm SCM_TESTS = tests/ccwl.scm tests/utils.scm tests/yaml.scm TESTS = $(SCM_TESTS) diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm index cdd1bbc..6a25bb0 100644 --- a/ccwl/ccwl.scm +++ b/ccwl/ccwl.scm @@ -32,10 +32,39 @@ #:use-module (ice-9 match) #:use-module (ccwl utils) #:use-module (ccwl yaml) - #:export (command - workflow)) - -(define %cwl-version "v1.2") + #:export (command? + command + command-inputs + command-outputs + command-args + command-stdin + command-other + workflow + workflow? + workflow-steps + workflow-inputs + workflow-outputs + workflow-other + input? + input-id + input-type + input-label + input-default + input-position + input-prefix + input-other + output? + output-id + output-type + output-binding + output-source + output-other + step? + step-id + step-run + step-in + step-out + unspecified-default?)) (define-immutable-record-type (make-input id type label default position prefix other) @@ -87,17 +116,6 @@ (id (identifier? #'id) (output #'(id))) (_ (error "Invalid output:" (syntax->datum output-spec))))) -(define (filter-alist alist) - "Filter ALIST removing entries with #f as the value. If the -resulting association list is empty, return #f. Else, return that -association list." - (match (filter (match-lambda - ((_ . #f) #f) - (_ #t)) - alist) - (() #f) - (result result))) - (define-immutable-record-type (make-step id run in out) step? @@ -115,6 +133,14 @@ association list." (stdin command-stdin) (other command-other)) +(define-immutable-record-type + (make-workflow steps inputs outputs other) + workflow? + (steps workflow-steps) + (inputs workflow-inputs) + (outputs workflow-outputs) + (other workflow-other)) + (define (input-spec-id input-spec) "Return the identifier symbol of INPUT-SPEC." (syntax->datum @@ -197,86 +223,6 @@ RUN-ARGS. If such an input is not present in RUN-ARGS, return #f." (plist->alist args) (command-outputs command))) -(define* (make-workflow steps inputs outputs #:key (other '())) - "Build a Workflow class CWL workflow." - `((cwlVersion . ,%cwl-version) - (class . Workflow) - (requirements (SubworkflowFeatureRequirement)) - ,@other - (inputs . ,(map (lambda (input) - `(,(input-id input) - ,@(filter-alist - `((type . ,(input-type input)) - (label . ,(input-label input)) - (default . ,(and (not (unspecified-default? (input-default input))) - (input-default input))))) - ,@(input-other input))) - inputs)) - (outputs . ,(map (lambda (output) - `(,(output-id output) - (type . ,(match (output-type output) - ('stdout 'File) - (some-other-type some-other-type))) - (outputSource . ,(match (output-source output) - ((? string? source) source) - ((? input? input) (input-id input)))))) - outputs)) - (steps . ,(map (lambda (step) - `(,(step-id step) - (in . ,(map (lambda (in) - (match in - ((id . (? string? source)) - in) - ((id . (? input? input)) - (cons id (input-id input))))) - (step-in step))) - (out . ,(list->vector (map output-id (step-out step)))) - (run . ,(match (step-run step) - ((? command? command) - (command->cwl command)) - (tree tree))))) - steps)))) - -(define (output->cwl output) - `(,(output-id output) - ,@(filter identity - (list (and (output-type output) - (cons 'type (output-type output))) - (and (output-binding output) - (cons 'outputBinding (output-binding output))))) - ,@(output-other output))) - -(define (command->cwl command) - `((cwlVersion . ,%cwl-version) - (class . CommandLineTool) - ,@(command-other command) - (arguments . ,(list->vector - ;; Put string arguments into the arguments array. - (filter-mapi (lambda (arg index) - (and (string? arg) - `((position . ,index) - (valueFrom . ,arg)))) - (command-args command)))) - (inputs . ,(map (lambda (input) - `(,(input-id input) - ,@(filter-alist - `((type . ,(input-type input)) - (label . ,(input-label input)) - (default . ,(and (not (unspecified-default? (input-default input))) - (input-default input))) - (inputBinding . ,(filter-alist - `((position . ,(input-position input)) - (prefix . ,(input-prefix input))))))) - ,@(input-other input))) - (command-inputs command))) - (outputs . ,(map output->cwl (command-outputs command))) - ,@(if (command-stdin command) - `((stdin . ,(string-append "$(inputs." - (symbol->string - (command-stdin command)) - ".path)"))) - '()))) - (define (command-input-keys command) "Return the list of input keys accepted by COMMAND." (map input-id (command-inputs command))) @@ -309,23 +255,23 @@ command is not defined, return #f." (command? (variable-ref var)) (variable-ref var)))) -(define (workflow-steps x input-keys) - "Traverse ccwl source X and return two values---a list of output -keys and a list of steps. INPUT-KEYS is a list of supplied input -keys. Keys are represented by objects, and steps are represented -by objects." +(define (collect-steps x input-keys) + "Traverse ccwl workflow body X and return two values---a list of +output keys and a list of steps. INPUT-KEYS is a list of supplied +input keys. Keys are represented by objects, and steps are +represented by objects." (syntax-case x (pipe tee) ;; pipe ((pipe expressions ...) (foldn (lambda (expression input-keys steps) - (let ((input-keys child-steps (workflow-steps expression input-keys))) + (let ((input-keys child-steps (collect-steps expression input-keys))) (values input-keys (append steps child-steps)))) #'(expressions ...) input-keys (list))) ;; tee ((tee expressions ...) - (append-mapn (cut workflow-steps <> input-keys) + (append-mapn (cut collect-steps <> input-keys) #'(expressions ...))) ;; commands with only a single input and when only a single key is ;; available at this step @@ -335,13 +281,13 @@ by objects." (= (length (command-input-keys (command-object #'command))) 1)) - (workflow-steps #`(command (step-id) + (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)))) - input-keys)) + input-keys)) ((command (step-id) args ...) ;; Run a whole bunch of tests so that we can produce useful error ;; messages. @@ -402,8 +348,8 @@ by objects." (command-outputs command-object)))))) ;; commands with an implicit step identifier ((command args ...) - (workflow-steps #'(command (command) args ...) - input-keys)) + (collect-steps #'(command (command) args ...) + input-keys)) ;; any other unrecognized syntax (x (error "Unrecognized syntax:" (syntax->datum #'x))))) @@ -426,16 +372,17 @@ return #f." (syntax-case x () ((_ (inputs ...) tree) #`(let ((input-objects (list #,@(map input #'(inputs ...)))) - (output-keys steps (workflow-steps #'tree - (map (compose key input-spec-id) - #'(inputs ...))))) + (output-keys steps (collect-steps #'tree (map (compose key input-spec-id) + #'(inputs ...))))) ;; TODO: Error out on duplicated step IDs. + ;; TODO: Implement escape hatch #:other in workflow syntax. (make-workflow steps input-objects ;; Find the output object for each ;; output key. Filter out global ;; workflow inputs. (filter-map (cut key->output <> steps) - output-keys)))) + output-keys) + '()))) (x (error "Unrecognized workflow syntax [expected (workflow (input ...) tree)]:" (syntax->datum #'x)))))) diff --git a/ccwl/cwl.scm b/ccwl/cwl.scm new file mode 100644 index 0000000..47b30da --- /dev/null +++ b/ccwl/cwl.scm @@ -0,0 +1,132 @@ +;;; ccwl --- Concise Common Workflow Language +;;; Copyright © 2021 Arun Isaac +;;; +;;; This file is part of ccwl. +;;; +;;; ccwl is free software: you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation, either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; ccwl is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with ccwl. If not, see . + +;;; Commentary: + +;; This file implements conversion from ccwl objects (, +;; , , , ) to CWL YAML. + +;;; Code: + +(define-module (ccwl cwl) + #:use-module (ice-9 match) + #:use-module (ccwl ccwl) + #:use-module (ccwl utils) + #:use-module (ccwl yaml) + #:export (workflow->cwl)) + +(define %cwl-version "v1.2") + +(define (workflow->cwl workflow port) + "Render WORKFLOW, a object, to PORT as a CWL YAML +specification." + (scm->yaml (workflow->cwl-scm workflow) + port)) + +(define (filter-alist alist) + "Filter ALIST removing entries with #f as the value. If the +resulting association list is empty, return #f. Else, return that +association list." + (match (filter (match-lambda + ((_ . #f) #f) + (_ #t)) + alist) + (() #f) + (result result))) + +(define* (workflow->cwl-scm workflow) + "Render WORKFLOW, a object, into a CWL tree." + `((cwlVersion . ,%cwl-version) + (class . Workflow) + (requirements (SubworkflowFeatureRequirement)) + ,@(workflow-other workflow) + (inputs . ,(map (lambda (input) + `(,(input-id input) + ,@(filter-alist + `((type . ,(input-type input)) + (label . ,(input-label input)) + (default . ,(and (not (unspecified-default? (input-default input))) + (input-default input))))) + ,@(input-other input))) + (workflow-inputs workflow))) + (outputs . ,(map (lambda (output) + `(,(output-id output) + (type . ,(match (output-type output) + ('stdout 'File) + (some-other-type some-other-type))) + (outputSource . ,(match (output-source output) + ((? string? source) source) + ((? input? input) (input-id input)))))) + (workflow-outputs workflow))) + (steps . ,(map (lambda (step) + `(,(step-id step) + (in . ,(map (lambda (in) + (match in + ((id . (? string? source)) + in) + ((id . (? input? input)) + (cons id (input-id input))))) + (step-in step))) + (out . ,(list->vector (map output-id (step-out step)))) + (run . ,(match (step-run step) + ((? command? command) + (command->cwl-scm command)) + (tree tree))))) + (workflow-steps workflow))))) + +(define (output->cwl-scm output) + "Render OUTPUT, a object, into a CWL tree." + `(,(output-id output) + ,@(filter identity + (list (and (output-type output) + (cons 'type (output-type output))) + (and (output-binding output) + (cons 'outputBinding (output-binding output))))) + ,@(output-other output))) + +(define (command->cwl-scm command) + "Render COMMAND, a object, into a CWL tree." + `((cwlVersion . ,%cwl-version) + (class . CommandLineTool) + ,@(command-other command) + (arguments . ,(list->vector + ;; Put string arguments into the arguments array. + (filter-mapi (lambda (arg index) + (and (string? arg) + `((position . ,index) + (valueFrom . ,arg)))) + (command-args command)))) + (inputs . ,(map (lambda (input) + `(,(input-id input) + ,@(filter-alist + `((type . ,(input-type input)) + (label . ,(input-label input)) + (default . ,(and (not (unspecified-default? (input-default input))) + (input-default input))) + (inputBinding . ,(filter-alist + `((position . ,(input-position input)) + (prefix . ,(input-prefix input))))))) + ,@(input-other input))) + (command-inputs command))) + (outputs . ,(map output->cwl-scm (command-outputs command))) + ,@(if (command-stdin command) + `((stdin . ,(string-append "$(inputs." + (symbol->string + (command-stdin command)) + ".path)"))) + '()))) diff --git a/scripts/ccwl.in b/scripts/ccwl.in index 939cdf2..d0145d7 100755 --- a/scripts/ccwl.in +++ b/scripts/ccwl.in @@ -27,15 +27,15 @@ (use-modules (ice-9 match) (ccwl ccwl) - (ccwl yaml)) + (ccwl cwl)) (match (command-line) ((_ "compile" input-file) ;; FIXME: Compiling ccwl files fails since the workflow macro is ;; unable to access command definitions. (set! %load-should-auto-compile #f) - (scm->yaml (load (canonicalize-path input-file)) - (current-output-port))) + (workflow->cwl (load (canonicalize-path input-file)) + (current-output-port))) ((program _ ...) (format (current-error-port) "Usage: ~a compile input-file~%" diff --git a/tests/ccwl.scm b/tests/ccwl.scm index dfdc7c0..8cbe009 100644 --- a/tests/ccwl.scm +++ b/tests/ccwl.scm @@ -25,8 +25,8 @@ (not (assoc-ref (assoc-ref (assoc-ref - ((module-ref (resolve-module '(ccwl ccwl)) - 'command->cwl) + ((module-ref (resolve-module '(ccwl cwl)) + 'command->cwl-scm) (command #:inputs (file #:type 'File) #:run "wc" "-c" #:stdin file)) -- cgit v1.2.3