aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2021-06-01 14:53:34 +0530
committerArun Isaac2021-06-01 14:53:34 +0530
commit676322e6756c9a3b52d8cd1d0e6fd39f7ccc7983 (patch)
treece303167e77ac67a23b793f6200a9f9210fe2fcb
parentd81daca37de347ed7e59eacfad87e4c24daa462a (diff)
downloadccwl-676322e6756c9a3b52d8cd1d0e6fd39f7ccc7983.tar.gz
ccwl-676322e6756c9a3b52d8cd1d0e6fd39f7ccc7983.tar.lz
ccwl-676322e6756c9a3b52d8cd1d0e6fd39f7ccc7983.zip
Introduce new command definition syntax.
* ccwl/ccwl.scm: Do not export input and output. (<input>): Delete source field. Add position field. (input): Accept position and prefix fields in constructor. Do not initialize non-existent source field. (<command>): Delete additional-inputs field. Add inputs field. Delete set-command-outputs and set-command-stdin setters. (command): Rewrite as macro that accepts new command definition syntax. (<cli-element>): Delete type. (command->cwl): Generate CWL from new <command> type. (command-input-keys): Simplify to support new <command> type.
-rw-r--r--ccwl/ccwl.scm204
1 files changed, 111 insertions, 93 deletions
diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm
index 81f9a13..55db7a0 100644
--- a/ccwl/ccwl.scm
+++ b/ccwl/ccwl.scm
@@ -33,8 +33,6 @@
#:use-module (ccwl yaml)
#:export (command
workflow
- input
- output
step
pipeline
write-cwl))
@@ -42,13 +40,13 @@
(define %cwl-version "v1.2")
(define-immutable-record-type <input>
- (make-input id type label default source prefix other)
+ (make-input id type label default position prefix other)
input?
(id input-id)
(type input-type)
(label input-label)
(default input-default)
- (source input-source set-input-source)
+ (position input-position)
(prefix input-prefix)
(other input-other))
@@ -56,14 +54,10 @@
(make-unspecified-default)
unspecified-default?)
-(define* (input id #:key (type 'File) label (default (make-unspecified-default)) (other '()))
+(define* (input id #:key (type 'File) label (default (make-unspecified-default)) position prefix (other '()))
"Build and return an <input> object."
- ;; The user should never set source, and should not set prefix
- ;; directly during construction of the <input> object. Hence, do not
- ;; expose it as a parameter of this constructor.
- (let ((source #f)
- (prefix #f))
- (make-input id type label default source prefix other)))
+ (make-input id type label default position prefix other))
+
(define-immutable-record-type <output>
(make-output id type binding source other)
@@ -94,17 +88,85 @@
(out step-out))
(define-immutable-record-type <command>
- (make-command additional-inputs outputs args stdin other)
+ (make-command inputs outputs args stdin other)
command?
- (additional-inputs command-additional-inputs)
- (outputs command-outputs set-command-outputs)
+ (inputs command-inputs)
+ (outputs command-outputs)
(args command-args)
- (stdin command-stdin set-command-stdin)
+ (stdin command-stdin)
(other command-other))
-(define command
- (lambda** (#:key stdin #:key* run (additional-inputs '()) (outputs '()) (other '()))
- (make-command additional-inputs outputs run stdin other)))
+;; TODO: Add fine-grained syntax checking.
+(define-syntax command
+ (lambda (x)
+ ((syntax-lambda** (#:key stdin #:key* (inputs '()) (outputs '()) run (other '()))
+ (let ((inputs
+ ;; Canonicalize inputs.
+ (map (lambda (x)
+ (syntax-case x ()
+ ((id args ...) (identifier? #'id)
+ #'(id args ...))
+ (id (identifier? #'id) #'(id))
+ (_ (error "Invalid input:" (syntax->datum x)))))
+ inputs)))
+ (unless run
+ (error "#:run key required in command definition" (syntax->datum x)))
+ #`(make-command
+ (list #,@(map (lambda (x)
+ (syntax-case x ()
+ ((id args ...)
+ ;; Instantiate <input> object with
+ ;; position and prefix.
+ #`(input 'id
+ #:position #,(list-index (lambda (x)
+ (syntax-case x ()
+ (input (identifier? #'input)
+ (eq? (syntax->datum #'id)
+ (syntax->datum #'input)))
+ ((_ input)
+ (eq? (syntax->datum #'id)
+ (syntax->datum #'input)))
+ (_ #f)))
+ run)
+ #:prefix #,(any (lambda (x)
+ (syntax-case x ()
+ ((prefix input)
+ (and (eq? (syntax->datum #'id)
+ (syntax->datum #'input))
+ #'prefix))
+ (_ #f)))
+ run)
+ args ...))))
+ inputs))
+ (list #,@(map (lambda (x)
+ ;; Instantiate <output> object.
+ (syntax-case x ()
+ ((id args ...) (identifier? #'id)
+ #'(output 'id args ...))
+ (id (identifier? #'id) #'(output 'id))
+ (_ (error "Invalid output:"
+ (syntax->datum x)))))
+ outputs))
+ (list #,@(map (lambda (x)
+ (syntax-case x ()
+ ;; Replace input symbol with quoted symbol.
+ (input (identifier? #'input)
+ #''input)
+ ;; Leave string as is.
+ (string-arg (string? (syntax->datum #'string-arg))
+ #'string-arg)
+ ;; Replace prefixed input symbol with
+ ;; quoted symbol.
+ ((prefix input) (and (string? (syntax->datum #'prefix))
+ (identifier? #'input))
+ #''input)
+ (_ (error "Invalid command element:"
+ (syntax->datum x)))))
+ run))
+ #,(and stdin #`'#,stdin)
+ (list #,@other))))
+ x)))
+
(define (input=? input1 input2)
(eq? (input-id input1)
@@ -165,78 +227,38 @@
(cons 'outputBinding (output-binding output)))))
,@(output-other output)))
-(define-immutable-record-type <cli-element>
- (make-cli-element argument position)
- cli-element?
- (argument cli-element-argument)
- (position cli-element-position))
(define (command->cwl command)
- (let ((elements
- ;; Add a position to all arguments, converting them to
- ;; <cli-element> objects.
- (map (lambda (arg position)
- (make-cli-element
- ;; If duplicate input, convert it to an expression
- ;; referring to the input.
- (if (and (input? arg)
- (not (= (list-index (lambda (x)
- (and (input? x)
- (input=? arg x)))
- (command-args command))
- position)))
- (string-append "$(inputs." (symbol->string (input-id arg)) ")")
- arg)
- position))
- (command-args command)
- (iota (length (command-args command))))))
- `((cwlVersion . ,%cwl-version)
- (class . CommandLineTool)
- ,@(command-other command)
- (arguments . ,(list->vector
- ;; Put string arguments into the arguments array.
- (filter-map (lambda (element)
- (and (string? (cli-element-argument element))
- `((position . ,(cli-element-position element))
- (valueFrom . ,(cli-element-argument element)))))
- elements)))
- (inputs . ,(append
- ;; Put <input> arguments into the inputs array.
- (filter-map (lambda (element)
- (let ((input (cli-element-argument element)))
- (and (input? 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 . ,(cli-element-position element))
- (prefix . ,(input-prefix input)))))))
- ,@(input-other input)))))
- elements)
- (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)))
- (command-additional-inputs command))
- (let ((stdin (command-stdin command)))
- (if stdin
- (list `(,(input-id stdin)
- (type . ,(input-type stdin))))
- (list)))))
- (outputs . ,(map output->cwl (command-outputs command)))
- ,@(if (command-stdin command)
- `((stdin . ,(string-append "$(inputs."
- (symbol->string
- (input-id (command-stdin command)))
- ".path)")))
- '()))))
+ `((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)))
+ ;; FIXME: inputBinding can be an empty dictionary.
+ (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 (write-cwl step file)
(call-with-output-file file
@@ -248,11 +270,7 @@
(define (command-input-keys command)
"Return the list of input keys accepted by COMMAND."
- (map input-id
- (append (filter input? (command-args command))
- (command-additional-inputs command)
- (cond ((command-stdin command) => list)
- (else (list))))))
+ (map input-id (command-inputs command)))
(define-immutable-record-type <key>
(make-key name step)