summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile.am2
-rw-r--r--ccwl/ccwl.scm167
-rw-r--r--ccwl/cwl.scm132
-rwxr-xr-xscripts/ccwl.in6
-rw-r--r--tests/ccwl.scm4
5 files changed, 195 insertions, 116 deletions
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 <input>
(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 <step>
(make-step id run in out)
step?
@@ -115,6 +133,14 @@ association list."
(stdin command-stdin)
(other command-other))
+(define-immutable-record-type <workflow>
+ (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 <key> objects, and steps are represented
-by <step> 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 <key> objects, and steps are
+represented by <step> 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 <step> 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 <step> 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 <arunisaac@systemreboot.net>
+;;;
+;;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file implements conversion from ccwl objects (<workflow>,
+;; <command>, <input>, <output>, <step>) 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 <workflow> 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 <workflow> 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 <output> 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 <command> 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))
generated by cgit v1.2.3 (git 2.45.2) at 2024-12-22 18:12:37 +0000