ccwl: Implement js-expression.

js-expression corresponds to ExpressionTool in the CWL specification.

* ccwl/ccwl.scm (<js-expression>): New type.
(js-expression): New macro.
(function-inputs, function-outputs, function-object): Support
<js-expression> objects.
(function-input-keys): Mention <js-expression> objects in docstring.
* ccwl/cwl.scm (function->cwl, workflow->cwl-scm): Support
<js-expression> objects.
(command->cwl-scm): Move staging requirements handling to ...
(staging-requirements): ... this new function.
(js-expression->cwl, js-expression->cwl-scm): New functions.
* ccwl/graphviz.scm (function->dot): Support <js-expression> objects.
(command->graph): Abstract to ...
(single-node-workflow->graph): ... this new function.
(js-expression->dot, js-expression->graph): New functions.
* scripts/ccwl (main): Support <js-expression> objects.
* doc/ccwl.skb (Cookbook){Javascript expressions via ExpressionTool}:
New section.
* doc/js-expression-iota.scm: New file.

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 ...)