diff options
| -rw-r--r-- | ccwl/ccwl.scm | 82 | ||||
| -rw-r--r-- | ccwl/cwl.scm | 55 | ||||
| -rw-r--r-- | ccwl/graphviz.scm | 57 | ||||
| -rw-r--r-- | doc/ccwl.skb | 12 | ||||
| -rw-r--r-- | doc/js-expression-iota.scm | 7 | ||||
| -rwxr-xr-x | scripts/ccwl | 3 |
6 files changed, 176 insertions, 40 deletions
diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm index 97485da..d4f766b 100644 --- a/ccwl/ccwl.scm +++ b/ccwl/ccwl.scm @@ -47,6 +47,13 @@ command-stdout command-requirements command-other + js-expression? + js-expression + js-expression-inputs + js-expression-expression + js-expression-outputs + js-expression-requirements + js-expression-other cwl-workflow? cwl-workflow cwl-workflow-file @@ -269,6 +276,15 @@ compared using @code{equal?}." (requirements command-requirements) (other command-other)) +(define-immutable-record-type <js-expression> + (make-js-expression inputs expression outputs requirements other) + js-expression? + (inputs js-expression-inputs) + (expression js-expression-expression) + (outputs js-expression-outputs) + (requirements js-expression-requirements) + (other js-expression-other)) + (define-immutable-record-type <cwl-workflow> (make-cwl-workflow file inputs outputs) cwl-workflow? @@ -285,10 +301,11 @@ compared using @code{equal?}." (other workflow-other)) (define (function-outputs function) - "Return the outputs of FUNCTION---a <command>, <cwl-workflow> or -<workflow> object." + "Return the outputs of FUNCTION---a <command>, <js-expression>, +<cwl-workflow> or <workflow> object." ((cond ((command? function) command-outputs) + ((js-expression? function) js-expression-outputs) ((cwl-workflow? function) cwl-workflow-outputs) ((workflow? function) workflow-outputs) (else (error "Unrecognized ccwl function" function))) @@ -500,6 +517,52 @@ identifiers defined in the commands." '#,other))) #'(args ...))))))) +(define-syntax js-expression + (lambda (x) + (syntax-case x () + ((_ args ...) + (guard (exception + ((unrecognized-keyword-assertion? exception) + (raise-exception + (match (condition-irritants exception) + ((irritant _ ...) + (condition (ccwl-violation irritant) + (formatted-message "Unrecognized keyword argument ~a in js-expression definition" + (syntax->datum irritant))))))) + ((invalid-keyword-arity-assertion? exception) + (raise-exception + (match (condition-irritants exception) + ;; TODO: Report all extra arguments, not just the + ;; first one. + ((keyword _ extra _ ...) + (condition (ccwl-violation extra) + (formatted-message "Unexpected extra argument ~a for unary keyword argument ~a" + (syntax->datum extra) + (syntax->datum keyword))))))) + ((invalid-positional-arguments-arity-assertion? exception) + (raise-exception + (match (condition-irritants exception) + ;; TODO: Report all extra positional arguments, not + ;; just the first one. + ((extra _ ...) + (condition (ccwl-violation extra) + (formatted-message "Unexpected extra positional argument ~a in js-expression definition" + (syntax->datum extra)))))))) + (apply (syntax-lambda** (#:key expression (requirements #''()) (other #'()) #:key* inputs outputs) + (unless expression + (raise-exception + (condition (ccwl-violation x) + (formatted-message "Missing ~a key in command definition" + #:expression)))) + (ensure-yaml-serializable other "#:other") + #`(make-js-expression + (list #,@(map input inputs)) + #,expression + (list #,@(map output outputs)) + #,requirements + '#,other)) + #'(args ...))))))) + (define-syntax cwl-workflow (lambda (x) (syntax-case x () @@ -546,17 +609,19 @@ identifiers defined in the commands." (define (function-inputs function) "Return the list of inputs accepted by @var{function}---a -@code{<command>}, @code{<cwl-workflow>} or @code{<workflow> object." +@code{<command>}, @code{<js-expression>}, @code{<cwl-workflow>} or +@code{<workflow> object." ((cond ((command? function) command-inputs) + ((js-expression? function) js-expression-inputs) ((cwl-workflow? function) cwl-workflow-inputs) ((workflow? function) workflow-inputs) (else (error "Unrecognized ccwl function" function))) function)) (define (function-input-keys function) - "Return the list of input keys accepted by FUNCTION, a <command> -object or a <cwl-workflow> object." + "Return the list of input keys accepted by FUNCTION, a <command>, +<js-expression>, <cwl-workflow> or <workflow> object." (map input-id (function-inputs function))) @@ -597,14 +662,15 @@ an association list mapping keyword arguments to their values." (command-inputs command)))) (define (function-object x) - "Return the ccwl function object (a <command>, <cwl-workflow> -or <workflow> object) described by syntax X. If such a ccwl function -is not defined, return #f." + "Return the ccwl function object (a <command>, <js-expression>, +<cwl-workflow> or <workflow> object) described by syntax X. If such a +ccwl function is not defined, return #f." ;; TODO: What if function object is defined in lexical scope? (let ((result (false-if-exception (eval (syntax->datum x) (interaction-environment))))) (and (or (command? result) + (js-expression? result) (cwl-workflow? result) (workflow? result)) result))) diff --git a/ccwl/cwl.scm b/ccwl/cwl.scm index 3479492..baef519 100644 --- a/ccwl/cwl.scm +++ b/ccwl/cwl.scm @@ -41,7 +41,9 @@ (((? workflow? workflow) port) (workflow->cwl workflow port)) (((? command? command) port) - (command->cwl command port)))) + (command->cwl command port)) + (((? js-expression? expression) port) + (js-expression->cwl expression port)))) (define (workflow->cwl workflow port) "Render WORKFLOW, a <workflow> object, to PORT as a CWL YAML @@ -87,6 +89,8 @@ association list." (run . ,(match (step-run step) ((? command? command) (command->cwl-scm command)) + ((? js-expression? expression) + (js-expression->cwl-scm expression)) ((? cwl-workflow? cwl-workflow) (cwl-workflow-file cwl-workflow)) ((? workflow? workflow) @@ -147,22 +151,27 @@ CWL YAML specification." '()) ,@(input-other input))) +(define (staging-requirements inputs) + "Return @samp{InitialWorkDirRequirement} to stage any @var{inputs} that +must be staged." + (if (any input-stage? inputs) + ;; Stage any inputs that need to be. + `((InitialWorkDirRequirement + (listing . ,(list->vector + (filter-map (lambda (input) + (and (input-stage? input) + (string-append "$(inputs." + (symbol->string (input-id input)) + ")"))) + inputs))))) + '())) + (define (command->cwl-scm command) "Render COMMAND, a <command> object, into a CWL tree." `((cwlVersion . ,%cwl-version) (class . CommandLineTool) (requirements - ,@(if (any input-stage? (command-inputs command)) - ;; Stage any inputs that need to be. - `((InitialWorkDirRequirement - (listing . ,(list->vector - (filter-map (lambda (input) - (and (input-stage? input) - (string-append "$(inputs." - (symbol->string (input-id input)) - ")"))) - (command-inputs command)))))) - '()) + ,@(staging-requirements (command-inputs command)) ,@(command-requirements command)) ,@(command-other command) (arguments . ,(list->vector @@ -187,3 +196,25 @@ CWL YAML specification." ,@(if (command-stdout command) `((stdout . ,(command-stdout command))) '()))) + +(define (js-expression->cwl expression port) + "Render @var{expression}, a @code{<js-expression>} object, to +@var{port} as a CWL YAML specification." + (scm->yaml (js-expression->cwl-scm expression) + port)) + +(define (js-expression->cwl-scm expression) + "Render @var{expression}, a @code{<js-expression>} object, into +a CWL tree." + `((cwlVersion . ,%cwl-version) + (class . ExpressionTool) + (requirements + (InlineJavascriptRequirement) + ,@(staging-requirements (js-expression-inputs expression)) + ,@(js-expression-requirements expression)) + ,@(js-expression-other expression) + (inputs . ,(map input->cwl-scm + (js-expression-inputs expression))) + (outputs . ,(map output->cwl-scm + (js-expression-outputs expression))) + (expression . ,(js-expression-expression expression)))) diff --git a/ccwl/graphviz.scm b/ccwl/graphviz.scm index 2d39156..970af72 100644 --- a/ccwl/graphviz.scm +++ b/ccwl/graphviz.scm @@ -41,7 +41,9 @@ (((? workflow? workflow) port) (workflow->dot workflow port)) (((? command? command) port) - (command->dot command port)))) + (command->dot command port)) + (((? js-expression? expression) port) + (js-expression->dot expression port)))) (define (workflow->dot workflow port) "Render WORKFLOW, a <workflow> object, to PORT in the graphviz dot @@ -121,18 +123,13 @@ language." #:subgraphs (list (inputs-cluster (workflow-inputs workflow)) (outputs-cluster (workflow-outputs workflow))))) -(define (command->dot command port) - "Render @var{command}, a @code{<command>} object, to @var{port} in the -graphviz dot language." - (graph->dot (command->graph command) - port)) - -(define (command->graph command) - "Convert @var{command}, a @code{<command>} object, to a @code{<graph>} -object." +(define (single-node-workflow->graph node-name inputs outputs) + "Convert a single node workflow (usually a @code{<command>} or +@code{<js-expression>}) with @var{node-name}, @var{inputs} and +@var{outputs}, to a @code{<graph>} object." (graph 'workflow #:properties '((bgcolor . "#eeeeee")) - #:nodes (list (graph-node 'command + #:nodes (list (graph-node node-name '((fillcolor . "lightgoldenrodyellow") (shape . "record") (style . "filled")))) @@ -140,15 +137,41 @@ object." ;; Connect inputs to command. (map (lambda (input) (cons (input-id input) - 'command)) - (command-inputs command)) + node-name)) + inputs) ;; Connect command to outputs. (map (lambda (output) - (cons 'command + (cons node-name (output-id output))) - (command-outputs command))) - #:subgraphs (list (inputs-cluster (command-inputs command)) - (outputs-cluster (command-outputs command))))) + outputs)) + #:subgraphs (list (inputs-cluster inputs) + (outputs-cluster outputs)))) + +(define (command->dot command port) + "Render @var{command}, a @code{<command>} object, to @var{port} in the +graphviz dot language." + (graph->dot (command->graph command) + port)) + +(define (command->graph command) + "Convert @var{command}, a @code{<command>} object, to a @code{<graph>} +object." + (single-node-workflow->graph 'command + (command-inputs command) + (command-outputs command))) + +(define (js-expression->dot expression port) + "Render @var{expression}, a @code{<js-expression>} object, to +@var{port} in the graphviz dot language." + (graph->dot (js-expression->graph expression) + port)) + +(define (js-expression->graph expression) + "Convert @var{expression}, a @code{<js-expression>} object, to a +@code{<graph>} object." + (single-node-workflow->graph 'js-expression + (js-expression-inputs expression) + (js-expression-outputs expression))) (define (step-node id) "Return graph node describing step with @var{id}." diff --git a/doc/ccwl.skb b/doc/ccwl.skb index cb78fd5..23bd798 100644 --- a/doc/ccwl.skb +++ b/doc/ccwl.skb @@ -1,5 +1,5 @@ ;;; ccwl --- Concise Common Workflow Language -;;; Copyright © 2021, 2023 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2021, 2023–2024 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of ccwl. ;;; @@ -389,7 +389,15 @@ the external CWL workflow.] keys forward to the output. This is what the ,(code [identity]) construct is for. An example follows.] (scheme-source "doc/identity-construct.scm") - (image :file "doc/identity-construct.png")))) + (image :file "doc/identity-construct.png"))) + (section :title [Javascript expressions via ExpressionTool] + :ident "javascript-expressions-via-expressiontool" + (p [ccwl supports CWL's ,(samp "ExpressionTool") using its +,(code "js-expression") construct. The ,(code "js-expression") +construct may be invoked from within workflows just like ,(code +"command") constructs can be. Here's a workflow that uses ,(code +"js-expression") to construct an array of numbers from 0 to n-1.] + (scheme-source "doc/js-expression-iota.scm")))) (chapter :title [Contributing] :ident "chapter-contributing" diff --git a/doc/js-expression-iota.scm b/doc/js-expression-iota.scm new file mode 100644 index 0000000..066e4ae --- /dev/null +++ b/doc/js-expression-iota.scm @@ -0,0 +1,7 @@ +(define iota + (js-expression #:inputs (n #:type int) + #:expression "$({\"sequence\": Array.from(Array(inputs.n).keys())})" + #:outputs (sequence #:type (array int)))) + +(workflow ((n #:type int)) + (iota #:n n)) diff --git a/scripts/ccwl b/scripts/ccwl index 43cf224..984d22a 100755 --- a/scripts/ccwl +++ b/scripts/ccwl @@ -123,10 +123,11 @@ Compile SOURCE-FILE. (let ((result (load (canonicalize-path (assq-ref args 'source-file)) read-syntax))) (if (or (command? result) + (js-expression? result) (workflow? result)) result (raise-exception - (condition (formatted-message "Last expression in file ~a returns neither workflow nor command" + (condition (formatted-message "Last expression in file ~a returns none of workflow, command or js-expression" (assq-ref args 'source-file))))))) (current-output-port))))) ((program args ...) |