From d22f48630c08ef79fe25c580126a8d9bd373c522 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Mon, 24 Nov 2025 00:24:08 +0000 Subject: reader: Use CWL types in type coercion. --- ravanan/command-line-tool.scm | 2 +- ravanan/reader.scm | 42 ++++++++++++++++++++++++++++++----- tests/reader.scm | 51 +++++++++++++++++++++++++++++++++++++++++-- 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") -- cgit 1.4.1