reader: Use CWL types in type coercion.

3 files changed, 86 insertions, 9 deletions

diff --git a/ravanan/command-line-tool.scm b/ravanan/command-line-tool.scm
index f5edfc1..e8b7eb8 100644
--- a/ravanan/command-line-tool.scm
+++ b/ravanan/command-line-tool.scm
@@ -307,7 +307,7 @@ the built script as a monadic value."
                            (compose just
                                     inexact->exact
                                     ceiling
-                                    (cut coerce-type <> 'number)
+                                    (cut coerce-type <> 'int)
                                     (cut coerce-expression
                                          <>
                                          `(("inputs" . ,inputs)))))
diff --git a/ravanan/reader.scm b/ravanan/reader.scm
index 2d10450..b8687b0 100644
--- a/ravanan/reader.scm
+++ b/ravanan/reader.scm
@@ -35,6 +35,11 @@
             read-inputs
             coerce-type))
 
+(define-condition-type &type-coercion-violation &violation
+  type-coercion-violation type-coercion-violation?
+  (value type-coercion-violation-value)
+  (type type-coercion-violation-type))
+
 (define (preprocess-include tree)
   (cond
    ;; Arrays
@@ -325,19 +330,44 @@ array of array of @code{File}s, etc. Else, return @code{#f}"
                    (read-yaml-file (basename inputs-path)))))))))
 
 (define (coerce-type val type)
-  "Coerce @var{val} to @var{type}."
+  "Coerce @var{val} to CWL @var{type}."
   ;; This function exists to handle YAML's type ambiguities.
   (case type
     ((boolean)
      (cond
       ((member val (list "true" "yes")) #t)
       ((member val (list "false" "no")) #f)
-      (else (error "Unable to coerce value to type" val type))))
-    ((number)
-     (if (number? val)
+      (else (raise-exception (type-coercion-violation val type)))))
+    ((int float double)
+     (cond
+      ((number? val) val)
+      ((string? val) (string->number val))
+      (else (raise-exception (type-coercion-violation val type)))))
+    ((string)
+     (if (string? val)
          val
-         (string->number val)))
-    (else val)))
+         (raise-exception (type-coercion-violation val type))))
+    ((File)
+     (if (and (list? val)
+              (string=? (assoc-ref val "class")
+                        "File"))
+         val
+         (raise-exception (type-coercion-violation val type))))
+    (else
+     (cond
+      ((cwl-array-type? type)
+       (vector-map (cut coerce-type <> (cwl-array-type-subtype type))
+                   val))
+      ((cwl-union-type? type)
+       (match (cwl-union-type-subtypes type)
+         (()
+          (raise-exception (type-coercion-violation val type)))
+         ((head-subtype tail-subtypes ...)
+          (guard (c ((type-coercion-violation? c)
+                     (coerce-type val (cwl-union-type tail-subtypes))))
+            (coerce-type val head-subtype)))))
+      (else
+       (error "Invalid type to coerce to" type))))))
 
 (define (read-json-file file)
   "Read JSON @var{file} and return scheme tree."
diff --git a/tests/reader.scm b/tests/reader.scm
index 75d5ac8..8ac18ec 100644
--- a/tests/reader.scm
+++ b/tests/reader.scm
@@ -22,6 +22,7 @@
              (web uri)
              (ravanan reader)
              (ravanan work command-line-tool)
+             (ravanan work types)
              (ravanan work utils))
 
 (define normalize-formal-input
@@ -35,9 +36,55 @@
 
 (test-begin "reader")
 
-(test-equal "Coerce number to number"
+(test-equal "Coerce to boolean (true)"
+  #t
+  (coerce-type "true" 'boolean))
+
+(test-equal "Coerce to boolean (false)"
+  #f
+  (coerce-type "false" 'boolean))
+
+(test-equal "Coerce to int"
+  37
+  (coerce-type "37" 'int))
+
+(test-equal "Coerce to float"
+  37.1
+  (coerce-type "37.1" 'float))
+
+(test-equal "Coerce to double"
+  37.1
+  (coerce-type "37.1" 'double))
+
+(test-equal "Coerce to string"
+  "37"
+  (coerce-type "37" 'string))
+
+(test-equal "Coerce to File"
+  '(("class" . "File")
+    ("location" . "foo"))
+  (coerce-type '(("class" . "File")
+                 ("location" . "foo"))
+               'File))
+
+(test-equal "Coerce to array"
+  #(1 2 3)
+  (coerce-type #("1" "2" "3")
+               (cwl-array-type 'int)))
+
+(test-equal "Coerce to union type (int first)"
+  37
+  (coerce-type "37"
+               (cwl-union-type 'int 'string)))
+
+(test-equal "Coerce to union type (string first)"
+  "37"
+  (coerce-type "37"
+               (cwl-union-type 'string 'int)))
+
+(test-equal "Coerce int to int"
   37
-  (coerce-type 37 'number))
+  (coerce-type 37 'int))
 
 (test-equal "Normalize File type formal input"
   (canonicalize-json '(("type" . "File")