From ead05e253861cc796eaf21d19cae1ae3707bef9e Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Sat, 27 Feb 2021 18:51:48 +0530
Subject: Rename project to ccwl.

ccwl stands for Concise Common Workflow Language.

* generate-cwl/ccwl.scm: Move to ccwl/ccwl.scm.
* generate-cwl/yaml.scm: Move to ccwl/yaml.scm.
---
 ccwl/ccwl.scm                 | 214 ++++++++++++++++++++++++++++++++++++++++++
 ccwl/yaml.scm                 |  85 +++++++++++++++++
 generate-cwl/generate-cwl.scm | 214 ------------------------------------------
 generate-cwl/yaml.scm         |  85 -----------------
 4 files changed, 299 insertions(+), 299 deletions(-)
 create mode 100644 ccwl/ccwl.scm
 create mode 100644 ccwl/yaml.scm
 delete mode 100644 generate-cwl/generate-cwl.scm
 delete mode 100644 generate-cwl/yaml.scm

diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm
new file mode 100644
index 0000000..1f69d41
--- /dev/null
+++ b/ccwl/ccwl.scm
@@ -0,0 +1,214 @@
+;;
+;; CWL generator
+;;
+;; This file implements a generator to generate CWL files.
+
+(define-module (ccwl ccwl)
+  #:use-module (rnrs records syntactic)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-71)
+  #:use-module (ice-9 match)
+  #:export (clitool
+            workflow
+            input
+            output
+            step
+            workflow-output
+            intermediate
+            clitool-step))
+
+(define-record-type (<input> make-input input?)
+  (fields (immutable id input-id)
+          (immutable type input-type)
+          (immutable default input-default)
+          (immutable label input-label)
+          (immutable other input-other)))
+
+(define-record-type unspecified-default)
+
+(define* (input id #:key type label (default (make-unspecified-default)) (other '()))
+  "Build and return an <input> object."
+  (make-input id type default label other))
+
+(define-record-type (<output> make-output output?)
+  (fields (immutable id output-id)
+          (immutable type output-type)
+          (immutable binding output-binding)
+          (immutable other output-other)))
+
+(define* (output id #:key type binding (other '()))
+  "Build and return an <output> object."
+  (make-output id type binding other))
+
+(define-record-type (<intermediate> intermediate intermediate?)
+  (fields (immutable input intermediate-input)
+          (immutable output-source intermediate-output-source)))
+
+(define* (clitool-step id args #:key (additional-inputs '()) (outputs '()) stdout stderr (other '()))
+  (step id
+        (clitool (map (lambda (arg)
+                        (if (intermediate? arg)
+                            (intermediate-input arg)
+                            arg))
+                      args)
+                 #:additional-inputs additional-inputs
+                 #:outputs outputs
+                 #:stdout stdout
+                 #:stderr stderr
+                 #:other other)
+        (append (filter (lambda (arg)
+                          (or (input? arg)
+                              (intermediate? arg)))
+                        args)
+                additional-inputs)
+        (map output-id outputs)))
+
+(define* (parse-arguments args #:optional (position 1))
+  "Parse ARGS, a list of command line arguments and return a parse
+tree of labelled arguments. POSITION is an internal recursion
+variable."
+  (match args
+    (((? string? head) tail ...)
+     (if (string-prefix? "-" head)
+         (match tail
+           ((tail-head tail ...)
+            (cons (list 'keyword head tail-head)
+                  (parse-arguments tail position))))
+         (error "Unrecognized argument" head)))
+    ((head tail ...)
+     (cons (list 'positional position head)
+           (parse-arguments tail (1+ position))))
+    (() '())))
+
+(define (parse-command args)
+  "Parse ARGS, a list of command line arguments and return two
+lists---the base command and the actual arguments."
+  (let ((base-command arguments
+                      (break (match-lambda
+                               ((arg next)
+                                (and (string? arg)
+                                     (string-prefix? "-" arg)
+                                     (input? next))))
+                             (map list args (drop args 1)))))
+    (values (append (map (match-lambda
+                           ((arg next) arg))
+                         base-command)
+                    (if (input? (last args))
+                        (list)
+                        (take-right args 1)))
+            (parse-arguments
+             (append (map (match-lambda
+                            ((arg next) arg))
+                          arguments)
+                     (if (input? (last args))
+                         (take-right args 1)
+                         (list)))))))
+
+(define (input->tree input)
+  "Convert INPUT, an <input> object, to a tree."
+  `(,(input-id input)
+    ,@(filter identity
+              (list (and (input-type input)
+                         (cons 'type (input-type input)))
+                    (and (input-label input)
+                         (cons 'label (input-label input)))
+                    (and (not (unspecified-default? (input-default input)))
+                         (cons 'default (input-default input)))))
+    ,@(input-other input)))
+
+(define* (clitool args #:key (additional-inputs '()) (outputs '()) stdout stderr (other '()))
+  "Build a CommandLineTool class CWL workflow."
+  (let ((base-command arguments (parse-command args)))
+    `((cwl-version . "v1.1")
+      (class . Command-line-tool)
+      ,@other
+      (base-command . ,(list->vector base-command))
+      ,@(let ((inputs (append arguments additional-inputs)))
+          (if (not (null? inputs))
+              `((inputs . ,(map (match-lambda
+                                  (('keyword prefix input)
+                                   (append (input->tree input)
+                                           `((input-binding (prefix . ,prefix)))))
+                                  (('positional position input)
+                                   (append (input->tree input)
+                                           `((input-binding (position . ,position)))))
+                                  (input
+                                   (input->tree input)))
+                                inputs)))
+              (list)))
+      ,@(if (or (not (null? outputs)) stdout stderr)
+            `((outputs . ,(map (lambda (output)
+                                 `(,(output-id output)
+                                   ,@(filter identity
+                                             (list (and (output-type output)
+                                                        (cons 'type (output-type output)))
+                                                   (and (output-binding output)
+                                                        (cons 'output-binding (output-binding output)))))
+                                   ,@(output-other output)))
+                               outputs)))
+            (list))
+      ,@(if stdout
+            `((stdout . ,stdout))
+            '())
+      ,@(if stderr
+            `((stderr . ,stderr))
+            '()))))
+
+(define-record-type (<workflow-output> make-workflow-output workflow-output?)
+  (fields (immutable id workflow-output-id)
+          (immutable type workflow-output-type)
+          (immutable source workflow-output-source)
+          (immutable other workflow-output-other)))
+
+(define* (workflow-output id #:key type source (other '()))
+  "Build and return a <workflow-output> object."
+  (make-workflow-output id type source other))
+
+(define-record-type (<step> step step?)
+  (fields (immutable id step-id)
+          (immutable run step-run)
+          (immutable in step-in)
+          (immutable out step-out)))
+
+(define* (workflow steps outputs #:key (other '()))
+  "Build a Workflow class CWL workflow."
+  `((cwlVersion . "v1.1")
+    (class . Workflow)
+    ,@other
+    (inputs . ,(delete-duplicates
+                (map input->tree
+                     (append
+                      (append-map (lambda (step)
+                                    (filter-map (match-lambda
+                                                  ((id . (? input? input)) input)
+                                                  ((? input? input) input)
+                                                  (_ #f))
+                                                (step-in step)))
+                                  steps)
+                      (filter-map (lambda (output)
+                                    (and (input? (workflow-output-source output))
+                                         (workflow-output-source output)))
+                                  outputs)))))
+    (outputs . ,(map (lambda (output)
+                       `(,(workflow-output-id output)
+                         (type . ,(workflow-output-type output))
+                         (output-source . ,(match (workflow-output-source output)
+                                             ((? string? source) source)
+                                             ((? input? input) (input-id input))))))
+                     outputs))
+    (steps . ,(map (lambda (step)
+                     `(,(step-id step)
+                       (in . ,(map (match-lambda
+                                     ((id . input)
+                                      (cons id (if (input? input)
+                                                   (input-id input)
+                                                   input)))
+                                     ((? input? input)
+                                      (cons (input-id input) (input-id input)))
+                                     ((? intermediate? intermediate)
+                                      (cons (input-id (intermediate-input intermediate))
+                                            (intermediate-output-source intermediate))))
+                                   (step-in step)))
+                       (out . ,(list->vector (step-out step)))
+                       (run . ,(step-run step))))
+                   steps))))
diff --git a/ccwl/yaml.scm b/ccwl/yaml.scm
new file mode 100644
index 0000000..2036815
--- /dev/null
+++ b/ccwl/yaml.scm
@@ -0,0 +1,85 @@
+;;
+;; scm->yaml
+;;
+;; This file implements a library to convert a scm tree to yaml.
+
+(define-module (ccwl yaml)
+  #:use-module (ice-9 match)
+  #:export (scm->yaml))
+
+(define (kebab->camel string)
+  "Convert STRING from kebab case to CAMEL case."
+  (match (string-split string #\-)
+    ((head tail ...)
+     (string-concatenate
+      (cons head (map string-titlecase tail))))))
+
+(define (display-atom atom port)
+  "Display ATOM in PORT converting from kebab case to camel case if
+ATOM is a symbol."
+  (cond
+   ((symbol? atom)
+    (display (string->symbol (kebab->camel (symbol->string atom))) port))
+   ((number? atom)
+    (display atom port))
+   ((string? atom)
+    ;; Escape string with double quotes if
+    ;; - every character is a digit or period, and the unescaped
+    ;; string can therefore be misinterpreted as a number
+    ;; - string contains the colon character
+    (if (or (string-every (char-set-union char-set:digit (char-set #\.)) atom)
+            (string-any #\: atom))
+        (write atom port)
+        (display atom port)))
+   ((boolean? atom)
+    (display (if atom "true" "false") port))
+   (else (error "Unknown atom" atom))))
+
+(define (indent-level port level)
+  "Emit whitespaces to PORT corresponding to nesting LEVEL."
+  (display (make-string (* 2 level) #\space) port))
+
+(define (display-array-element element port level)
+  "Display array ELEMENT to PORT at nesting LEVEL."
+  (display "- " port)
+  (scm->yaml element port (1+ level)))
+
+(define (display-dictionary-entry entry port level)
+  "Display dictionary ENTRY to PORT at nesting LEVEL."
+  (match entry
+    ((key . value)
+     (display-atom key port)
+     (display ":" port)
+     (match value
+       ((or #(_ ...)
+            ((_ . _) (_ . _) ...))
+        (newline port)
+        (indent-level port (1+ level))
+        (scm->yaml value port (1+ level)))
+       (_ (display " " port)
+          (scm->yaml value port level))))))
+
+(define* (scm->yaml scm #:optional (port (current-output-port)) (level 0))
+  "Convert SCM, an S-expression tree, to YAML and display to
+PORT. LEVEL is an internal recursion variable."
+  (match scm
+    (#(head tail ...)
+     (display-array-element head port level)
+     (for-each (lambda (element)
+                 (indent-level port level)
+                 (display-array-element element port level))
+               tail))
+    (#()
+     (display "[]" port))
+    ((head tail ...)
+     (display-dictionary-entry head port level)
+     (for-each (lambda (entry)
+                 (indent-level port level)
+                 (display-dictionary-entry entry port level))
+               tail))
+    (()
+     (display "{}" port)
+     (newline port))
+    (symbol
+     (display-atom symbol port)
+     (newline port))))
diff --git a/generate-cwl/generate-cwl.scm b/generate-cwl/generate-cwl.scm
deleted file mode 100644
index 4e6420a..0000000
--- a/generate-cwl/generate-cwl.scm
+++ /dev/null
@@ -1,214 +0,0 @@
-;;
-;; CWL generator
-;;
-;; This file implements a generator to generate CWL files.
-
-(define-module (generate-cwl generate-cwl)
-  #:use-module (rnrs records syntactic)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-71)
-  #:use-module (ice-9 match)
-  #:export (clitool
-            workflow
-            input
-            output
-            step
-            workflow-output
-            intermediate
-            clitool-step))
-
-(define-record-type (<input> make-input input?)
-  (fields (immutable id input-id)
-          (immutable type input-type)
-          (immutable default input-default)
-          (immutable label input-label)
-          (immutable other input-other)))
-
-(define-record-type unspecified-default)
-
-(define* (input id #:key type label (default (make-unspecified-default)) (other '()))
-  "Build and return an <input> object."
-  (make-input id type default label other))
-
-(define-record-type (<output> make-output output?)
-  (fields (immutable id output-id)
-          (immutable type output-type)
-          (immutable binding output-binding)
-          (immutable other output-other)))
-
-(define* (output id #:key type binding (other '()))
-  "Build and return an <output> object."
-  (make-output id type binding other))
-
-(define-record-type (<intermediate> intermediate intermediate?)
-  (fields (immutable input intermediate-input)
-          (immutable output-source intermediate-output-source)))
-
-(define* (clitool-step id args #:key (additional-inputs '()) (outputs '()) stdout stderr (other '()))
-  (step id
-        (clitool (map (lambda (arg)
-                        (if (intermediate? arg)
-                            (intermediate-input arg)
-                            arg))
-                      args)
-                 #:additional-inputs additional-inputs
-                 #:outputs outputs
-                 #:stdout stdout
-                 #:stderr stderr
-                 #:other other)
-        (append (filter (lambda (arg)
-                          (or (input? arg)
-                              (intermediate? arg)))
-                        args)
-                additional-inputs)
-        (map output-id outputs)))
-
-(define* (parse-arguments args #:optional (position 1))
-  "Parse ARGS, a list of command line arguments and return a parse
-tree of labelled arguments. POSITION is an internal recursion
-variable."
-  (match args
-    (((? string? head) tail ...)
-     (if (string-prefix? "-" head)
-         (match tail
-           ((tail-head tail ...)
-            (cons (list 'keyword head tail-head)
-                  (parse-arguments tail position))))
-         (error "Unrecognized argument" head)))
-    ((head tail ...)
-     (cons (list 'positional position head)
-           (parse-arguments tail (1+ position))))
-    (() '())))
-
-(define (parse-command args)
-  "Parse ARGS, a list of command line arguments and return two
-lists---the base command and the actual arguments."
-  (let ((base-command arguments
-                      (break (match-lambda
-                               ((arg next)
-                                (and (string? arg)
-                                     (string-prefix? "-" arg)
-                                     (input? next))))
-                             (map list args (drop args 1)))))
-    (values (append (map (match-lambda
-                           ((arg next) arg))
-                         base-command)
-                    (if (input? (last args))
-                        (list)
-                        (take-right args 1)))
-            (parse-arguments
-             (append (map (match-lambda
-                            ((arg next) arg))
-                          arguments)
-                     (if (input? (last args))
-                         (take-right args 1)
-                         (list)))))))
-
-(define (input->tree input)
-  "Convert INPUT, an <input> object, to a tree."
-  `(,(input-id input)
-    ,@(filter identity
-              (list (and (input-type input)
-                         (cons 'type (input-type input)))
-                    (and (input-label input)
-                         (cons 'label (input-label input)))
-                    (and (not (unspecified-default? (input-default input)))
-                         (cons 'default (input-default input)))))
-    ,@(input-other input)))
-
-(define* (clitool args #:key (additional-inputs '()) (outputs '()) stdout stderr (other '()))
-  "Build a CommandLineTool class CWL workflow."
-  (let ((base-command arguments (parse-command args)))
-    `((cwl-version . "v1.1")
-      (class . Command-line-tool)
-      ,@other
-      (base-command . ,(list->vector base-command))
-      ,@(let ((inputs (append arguments additional-inputs)))
-          (if (not (null? inputs))
-              `((inputs . ,(map (match-lambda
-                                  (('keyword prefix input)
-                                   (append (input->tree input)
-                                           `((input-binding (prefix . ,prefix)))))
-                                  (('positional position input)
-                                   (append (input->tree input)
-                                           `((input-binding (position . ,position)))))
-                                  (input
-                                   (input->tree input)))
-                                inputs)))
-              (list)))
-      ,@(if (or (not (null? outputs)) stdout stderr)
-            `((outputs . ,(map (lambda (output)
-                                 `(,(output-id output)
-                                   ,@(filter identity
-                                             (list (and (output-type output)
-                                                        (cons 'type (output-type output)))
-                                                   (and (output-binding output)
-                                                        (cons 'output-binding (output-binding output)))))
-                                   ,@(output-other output)))
-                               outputs)))
-            (list))
-      ,@(if stdout
-            `((stdout . ,stdout))
-            '())
-      ,@(if stderr
-            `((stderr . ,stderr))
-            '()))))
-
-(define-record-type (<workflow-output> make-workflow-output workflow-output?)
-  (fields (immutable id workflow-output-id)
-          (immutable type workflow-output-type)
-          (immutable source workflow-output-source)
-          (immutable other workflow-output-other)))
-
-(define* (workflow-output id #:key type source (other '()))
-  "Build and return a <workflow-output> object."
-  (make-workflow-output id type source other))
-
-(define-record-type (<step> step step?)
-  (fields (immutable id step-id)
-          (immutable run step-run)
-          (immutable in step-in)
-          (immutable out step-out)))
-
-(define* (workflow steps outputs #:key (other '()))
-  "Build a Workflow class CWL workflow."
-  `((cwlVersion . "v1.1")
-    (class . Workflow)
-    ,@other
-    (inputs . ,(delete-duplicates
-                (map input->tree
-                     (append
-                      (append-map (lambda (step)
-                                    (filter-map (match-lambda
-                                                  ((id . (? input? input)) input)
-                                                  ((? input? input) input)
-                                                  (_ #f))
-                                                (step-in step)))
-                                  steps)
-                      (filter-map (lambda (output)
-                                    (and (input? (workflow-output-source output))
-                                         (workflow-output-source output)))
-                                  outputs)))))
-    (outputs . ,(map (lambda (output)
-                       `(,(workflow-output-id output)
-                         (type . ,(workflow-output-type output))
-                         (output-source . ,(match (workflow-output-source output)
-                                             ((? string? source) source)
-                                             ((? input? input) (input-id input))))))
-                     outputs))
-    (steps . ,(map (lambda (step)
-                     `(,(step-id step)
-                       (in . ,(map (match-lambda
-                                     ((id . input)
-                                      (cons id (if (input? input)
-                                                   (input-id input)
-                                                   input)))
-                                     ((? input? input)
-                                      (cons (input-id input) (input-id input)))
-                                     ((? intermediate? intermediate)
-                                      (cons (input-id (intermediate-input intermediate))
-                                            (intermediate-output-source intermediate))))
-                                   (step-in step)))
-                       (out . ,(list->vector (step-out step)))
-                       (run . ,(step-run step))))
-                   steps))))
diff --git a/generate-cwl/yaml.scm b/generate-cwl/yaml.scm
deleted file mode 100644
index f4691ca..0000000
--- a/generate-cwl/yaml.scm
+++ /dev/null
@@ -1,85 +0,0 @@
-;;
-;; scm->yaml
-;;
-;; This file implements a library to convert a scm tree to yaml.
-
-(define-module (generate-cwl yaml)
-  #:use-module (ice-9 match)
-  #:export (scm->yaml))
-
-(define (kebab->camel string)
-  "Convert STRING from kebab case to CAMEL case."
-  (match (string-split string #\-)
-    ((head tail ...)
-     (string-concatenate
-      (cons head (map string-titlecase tail))))))
-
-(define (display-atom atom port)
-  "Display ATOM in PORT converting from kebab case to camel case if
-ATOM is a symbol."
-  (cond
-   ((symbol? atom)
-    (display (string->symbol (kebab->camel (symbol->string atom))) port))
-   ((number? atom)
-    (display atom port))
-   ((string? atom)
-    ;; Escape string with double quotes if
-    ;; - every character is a digit or period, and the unescaped
-    ;; string can therefore be misinterpreted as a number
-    ;; - string contains the colon character
-    (if (or (string-every (char-set-union char-set:digit (char-set #\.)) atom)
-            (string-any #\: atom))
-        (write atom port)
-        (display atom port)))
-   ((boolean? atom)
-    (display (if atom "true" "false") port))
-   (else (error "Unknown atom" atom))))
-
-(define (indent-level port level)
-  "Emit whitespaces to PORT corresponding to nesting LEVEL."
-  (display (make-string (* 2 level) #\space) port))
-
-(define (display-array-element element port level)
-  "Display array ELEMENT to PORT at nesting LEVEL."
-  (display "- " port)
-  (scm->yaml element port (1+ level)))
-
-(define (display-dictionary-entry entry port level)
-  "Display dictionary ENTRY to PORT at nesting LEVEL."
-  (match entry
-    ((key . value)
-     (display-atom key port)
-     (display ":" port)
-     (match value
-       ((or #(_ ...)
-            ((_ . _) (_ . _) ...))
-        (newline port)
-        (indent-level port (1+ level))
-        (scm->yaml value port (1+ level)))
-       (_ (display " " port)
-          (scm->yaml value port level))))))
-
-(define* (scm->yaml scm #:optional (port (current-output-port)) (level 0))
-  "Convert SCM, an S-expression tree, to YAML and display to
-PORT. LEVEL is an internal recursion variable."
-  (match scm
-    (#(head tail ...)
-     (display-array-element head port level)
-     (for-each (lambda (element)
-                 (indent-level port level)
-                 (display-array-element element port level))
-               tail))
-    (#()
-     (display "[]" port))
-    ((head tail ...)
-     (display-dictionary-entry head port level)
-     (for-each (lambda (entry)
-                 (indent-level port level)
-                 (display-dictionary-entry entry port level))
-               tail))
-    (()
-     (display "{}" port)
-     (newline port))
-    (symbol
-     (display-atom symbol port)
-     (newline port))))
-- 
cgit v1.2.3