ccwl: Factorize out CWL generation code to separate file.

This factorization is required to support other compilation targets
such as graphviz, bash, scheme, etc.

* ccwl/cwl.scm: New file.
* Makefile.am (SOURCES): Register it.
* ccwl/ccwl.scm (ccwl): Export command?, command-inputs,
command-outputs, command-args, command-stdin, command-other,
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?.
(<workflow>): New type.
(filter-alist): Move to cwl.scm.
(make-workflow): Refactor into workflow->cwl-scm in cwl.scm.
(output->cwl): Move to cwl.scm as output->cwl-scm.
(command->cwl): Move to cwl.scm as command->cwl-scm.
(workflow-steps): Rename to collect-steps. Clarify docstring.
(workflow): Use collect-steps instead of workflow-steps. Explicitly
pass empty list as other argument of make-workflow. Add TODO note to
implement it properly.
* scripts/ccwl.in: Import (ccwl cwl) instead of (ccwl yaml). Use
workflow->cwl instead of scm->yaml.
* tests/ccwl.scm ("stdin input should not have inputBinding"): Use
command->cwl-scm from (ccwl cwl) instead of command->cwl from (ccwl
ccwl).

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