aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2021-04-25 22:52:08 +0530
committerArun Isaac2021-04-26 00:25:06 +0530
commit0b3706a00dadab08f54b495d828bb151da525a1f (patch)
tree126986547692a4deb6c46b88bdc52c1b7f65cdfb
parent822c8fb3a0f28976da068f3dc8bf607d193d0fa1 (diff)
downloadccwl-0b3706a00dadab08f54b495d828bb151da525a1f.tar.gz
ccwl-0b3706a00dadab08f54b495d828bb151da525a1f.tar.lz
ccwl-0b3706a00dadab08f54b495d828bb151da525a1f.zip
Implement the CCWL embedded domain specific language.
* ccwl/ccwl.scm: Import (ccwl utils). (command): Return <command> object. (auto-connect): Delete function. (invoke-command, make-workflow, workflow-steps): New functions. (workflow): Replace function with macro.
-rw-r--r--ccwl/ccwl.scm181
1 files changed, 89 insertions, 92 deletions
diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm
index e173d9e..547cf23 100644
--- a/ccwl/ccwl.scm
+++ b/ccwl/ccwl.scm
@@ -28,6 +28,7 @@
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
+ #:use-module (ccwl utils)
#:use-module (ccwl yaml)
#:export (command
workflow
@@ -127,104 +128,68 @@
(define append-command-outputs
(field-appender command-outputs set-command-outputs))
-(define* (command id arguments #:key (additional-inputs '()) (outputs '()) (other '()))
- (make-step id
- (make-command additional-inputs outputs arguments #f other)
- ;; A command can use the same input multiple times. So,
- ;; deduplicate.
- (delete-duplicates
- (append (filter input? arguments)
- additional-inputs)
- input=?)
- outputs))
+(define* (command #:key run (additional-inputs '()) (outputs '()) stdin (other '()))
+ (make-command additional-inputs outputs run stdin other))
(define (input=? input1 input2)
(string=? (input-id input1)
(input-id input2)))
-(define (auto-connect steps)
- "Auto-connect STEPS by matching inputs to outputs using their unique
-identifiers. If any inputs are already matched, they are not
-re-matched."
- (map (lambda (step)
- (set-step-in step
- (map (lambda (input)
- ;; If input is already connected, return
- ;; it unaltered. Else, try to connect it
- ;; to a source.
- (cond
- ((input-source input)
- input)
- ;; Input that should be connected to
- ;; some intermediate output
- ((find (lambda (step)
- (member (input-id input)
- (map output-id (step-out step))))
- steps)
- => (lambda (source-step)
- (set-input-source input
- (string-append (step-id source-step)
- "/" (input-id input)))))
- ;; Non-internal input that should be
- ;; interfaced with the outside world
- (else input)))
- (step-in step))))
- steps))
-
-(define* (workflow id steps outputs #:key (other '()))
+(define (invoke-command step-id command . args)
+ (make-step step-id
+ command
+ (plist->alist args)
+ (command-outputs command)))
+
+(define* (make-workflow steps outputs #:key (other '()))
"Build a Workflow class CWL workflow."
- (let* ((steps (auto-connect steps))
- (inputs
- ;; When the same input is used by multiple steps, there will
- ;; be duplicates. So, deduplicate.
- (delete-duplicates
- (append (append-map step-in steps)
- ;; If an input is directly copied to the output, an
- ;; output-source will be an <input> object.
- (filter-map (lambda (output)
- (and (input? (output-source output))
- (output-source output)))
- outputs))
- input=?))
- ;; List of non-internal inputs that should be interfaced with
- ;; the outside world.
- (interface-inputs (remove input-source inputs)))
- (make-step id
- `((cwl-version . ,%cwl-version)
- (class . Workflow)
- (requirements (Subworkflow-feature-requirement))
- ,@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)))
- interface-inputs))
- (outputs . ,(map (lambda (output)
- `(,(output-id output)
- (type . ,(output-type output))
- (output-source . ,(match (output-source output)
- ((? string? source) source)
- ((? input? input) (input-id input))))))
- outputs))
- (steps . ,(map (lambda (step)
- `(,(step-id step)
- (in . ,(map (lambda (input)
- (cons (input-id input)
- (or (input-source input)
- (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)))
- interface-inputs
- outputs)))
+ `((cwl-version . ,%cwl-version)
+ (class . Workflow)
+ (requirements (Subworkflow-feature-requirement))
+ ,@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)))
+ ;; When the same input is used by multiple steps,
+ ;; there will be duplicates. So, deduplicate.
+ (delete-duplicates
+ (append-map (lambda (step)
+ (filter-map (match-lambda
+ ((_ . (? input? input))
+ input)
+ (_ #f))
+ (step-in step)))
+ steps)
+ input=?)))
+ (outputs . ,(map (lambda (output)
+ `(,(output-id output)
+ (type . ,(match (output-type output)
+ ('stdout 'File)
+ (some-other-type some-other-type)))
+ (output-source . ,(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* (pipeline id steps
#:optional
@@ -351,3 +316,35 @@ re-matched."
(command->cwl run)
run))
<>)))
+
+(define (workflow-steps x)
+ (syntax-case x ()
+ ((command (step-id) args ...)
+ (cons #`(invoke-command
+ step-id command
+ #,@(append-map (lambda (pair)
+ (syntax-case pair ()
+ ((key . (_ (id) _ ...))
+ (list #'key (string-append
+ (syntax->datum #'id)
+ "/" (symbol->string
+ (keyword->symbol
+ (syntax->datum #'key))))))
+ ((key . atom)
+ (list #'key #'atom))))
+ (pairify #'(args ...))))
+ (append-map workflow-steps #'(args ...))))
+ (atom (list))))
+
+(define-syntax workflow
+ (lambda (x)
+ (syntax-case x ()
+ ((_ root)
+ #`(make-workflow
+ (list #,@(workflow-steps #'root))
+ #,(syntax-case x ()
+ ((_ (command (step-id) _ ...))
+ #'(map (lambda (output)
+ (set-output-source
+ output (string-append step-id "/" (output-id output))))
+ (command-outputs command)))))))))