diff options
| -rw-r--r-- | HACKING.md | 2 | ||||
| -rw-r--r-- | e2e-tests/jobs/command-line-tool-with-array-input.yaml | 3 | ||||
| -rw-r--r-- | e2e-tests/tests.yaml | 9 | ||||
| -rw-r--r-- | e2e-tests/tools/command-line-tool-with-array-input.scm | 3 | ||||
| -rw-r--r-- | ravanan/command-line-tool.scm | 5 | ||||
| -rw-r--r-- | ravanan/javascript.scm | 62 | ||||
| -rw-r--r-- | ravanan/store.scm | 16 | ||||
| -rw-r--r-- | ravanan/work/command-line-tool.scm | 84 | ||||
| -rw-r--r-- | ravanan/work/utils.scm | 5 | ||||
| -rw-r--r-- | ravanan/workflow.scm | 15 | ||||
| -rw-r--r-- | tests/javascript.scm | 36 | ||||
| -rw-r--r-- | tests/work/utils.scm | 29 |
12 files changed, 186 insertions, 83 deletions
diff --git a/HACKING.md b/HACKING.md index 4d8b6fe..7df6d02 100644 --- a/HACKING.md +++ b/HACKING.md @@ -18,8 +18,6 @@ $(guix build -L ../.guix -f ../.guix/e2e-tests.scm) ``` Since ravanan depends on guix, and that guix may be too old, you may need to run this command outside the usual development environment. -## Run specific end-to-end test - When hacking on ravanan, you may be trying to get a specific test to pass, and may want to repeatedly run that specific test alone. You can do this by passing additional cwltest arguments. For example, to only run the `hello-world` test: ``` $(guix build -L ../.guix -f ../.guix/e2e-tests.scm) -s hello-world diff --git a/e2e-tests/jobs/command-line-tool-with-array-input.yaml b/e2e-tests/jobs/command-line-tool-with-array-input.yaml new file mode 100644 index 0000000..a0fc50c --- /dev/null +++ b/e2e-tests/jobs/command-line-tool-with-array-input.yaml @@ -0,0 +1,3 @@ +messages: + - foo + - bar diff --git a/e2e-tests/tests.yaml b/e2e-tests/tests.yaml index d14b93a..6604e39 100644 --- a/e2e-tests/tests.yaml +++ b/e2e-tests/tests.yaml @@ -241,3 +241,12 @@ class: File size: 13 checksum: sha1$47a013e660d408619d894b20806b1d5086aab03b +- id: command-line-tool-with-array-input + doc: CommandLineTool with array input + tool: tools/command-line-tool-with-array-input.cwl + job: jobs/command-line-tool-with-array-input.yaml + output: + output_message: + class: File + size: 8 + checksum: sha1$d53a205a336e07cf9eac45471b3870f9489288ec diff --git a/e2e-tests/tools/command-line-tool-with-array-input.scm b/e2e-tests/tools/command-line-tool-with-array-input.scm new file mode 100644 index 0000000..38a8722 --- /dev/null +++ b/e2e-tests/tools/command-line-tool-with-array-input.scm @@ -0,0 +1,3 @@ +(command #:inputs (messages #:type (array string)) + #:run "echo" messages + #:outputs (output_message #:type stdout)) diff --git a/ravanan/command-line-tool.scm b/ravanan/command-line-tool.scm index bb2f1b7..8fa7d23 100644 --- a/ravanan/command-line-tool.scm +++ b/ravanan/command-line-tool.scm @@ -154,11 +154,6 @@ class. Else, return @code{#f}." requirements)) supplementary-requirements))) -(define (javascript-expression? str) - "Return @code{#t} if @var{str} contains a CWL javascript expression. Else, return -@code{#f}." - (string-contains str "$(")) - (define* (coerce-expression expression #:optional context) "Coerce @var{expression} into a scheme JSON tree. diff --git a/ravanan/javascript.scm b/ravanan/javascript.scm index 1edad00..474c01c 100644 --- a/ravanan/javascript.scm +++ b/ravanan/javascript.scm @@ -37,7 +37,8 @@ #:use-module (ravanan work command-line-tool) #:use-module (ravanan work ui) #:use-module (ravanan work utils) - #:export (evaluate-javascript-expression)) + #:export (javascript-expression? + evaluate-javascript-expression)) ;; node executable for evaluating javascript on worker nodes (define %worker-node @@ -70,7 +71,9 @@ (and (or (and (ignore ".") symbol) singleq doubleq index))) (define-peg-pattern parameter-reference all - (and (ignore "$(") symbol (* segment) (ignore ")"))) + (and (ignore "$(") + (or "inputs" "self" "runtime") + (* segment) (ignore ")"))) (define-peg-pattern javascript-subexpression body (and "(" @@ -82,14 +85,36 @@ (define-peg-pattern javascript-expression all (and (ignore "$") javascript-subexpression)) +(define-peg-pattern javascript-function-body-subexpression body + (and "{" + (* (or (and (not-followed-by (or "{" "}")) + peg-any) + javascript-function-body-subexpression)) + "}")) + +(define-peg-pattern javascript-function-body all + (and (ignore "$") javascript-function-body-subexpression)) + +(define-peg-pattern whitespace body + (or "\t" "\n" "\r" " ")) + (define-peg-pattern string-literal body - (* (and (not-followed-by "$(") + (+ (and (not-followed-by (or "$(" whitespace)) peg-any))) (define-peg-pattern javascript all - (* (or parameter-reference - javascript-expression - string-literal))) + (and (ignore (* whitespace)) + (* (and (* whitespace) + (or parameter-reference + javascript-expression + javascript-function-body + string-literal))) + (ignore (* whitespace)))) + +(define (javascript-expression? str) + "Return true value if @var{str} contains inline javascript or parameter +references. Return @code{#f} otherwise." + (match-pattern javascript str)) (define* (evaluate-expression-tree-1 expression-tree context expression-lib) "Compile javascript @var{expression-tree} to a G-expression that evaluates @@ -107,17 +132,6 @@ keys @code{\"inputs\"}, @code{\"self\"} and @code{\"runtime\"}. ;; String literal ((? string? str) str) - ;; Special case for null - (('parameter-reference "null") - (if context - 'null - #~'null)) - ;; Disallow referencing anything other than inputs, self or runtime. - (('parameter-reference (and (not (or "inputs" "self" "runtime")) - symbol) - _ ...) - (user-error "Invalid parameter reference; `~a' unknown" - symbol)) ;; Parse parameter reference. The strange and complex matching pattern for ;; segments accounts for how (ice-9 peg) adds an additional layer of ;; parentheses to the tree when there are 2 or more segments. @@ -144,9 +158,21 @@ keys @code{\"inputs\"}, @code{\"self\"} and @code{\"runtime\"}. segments)) context expression-lib))))) + ;; Quick short circuiting for null, true and false + (('javascript-expression "(null)") + (if context 'null #~'null)) + (('javascript-expression "(true)") + (if context #t #~#t)) + (('javascript-expression "(false)") + (if context #f #~#f)) ;; This is a more complex javascript expression. Fall back to node. (('javascript-expression expression) - (evaluate-using-node expression context expression-lib)))) + (evaluate-using-node expression context expression-lib)) + ;; This is a javascript function body. Fall back to node. + (('javascript-function-body function-body) + (evaluate-using-node (string-append "(function() {" function-body "})()") + context + expression-lib)))) (define (evaluate-using-node expression context expression-lib) "Evaluate javascript @var{expression} using the node javascript engine in diff --git a/ravanan/store.scm b/ravanan/store.scm index a52bb50..f96354b 100644 --- a/ravanan/store.scm +++ b/ravanan/store.scm @@ -117,20 +117,12 @@ already exists, do nothing." ".stderr")) store)) -(define (same-filesystem? path1 path2) - "Return @code{#t} if @var{path1} and @var{path2} are on the same filesystem. -Else, return @code{#f}." - (= (stat:dev (stat path1)) - (stat:dev (stat path2)))) - (define (link-or-copy source destination) "Hard link @var{source} to @var{destination} if possible. Else, copy it." - ;; Hard link if the source file is on the same filesystem as the destination - ;; directory. Else, copy. - ((if (same-filesystem? source (dirname destination)) - link - copy-file) - source destination)) + ;; Hard linking can sometimes fail (when files are on different filesystems, + ;; different mounts, etc.). In such cases, fall back to copying. + (or (false-if-exception (link source destination)) + (copy-file source destination))) (define (intern-file file store) "Intern @code{File} type object @var{file} into the ravanan @var{store} unless it diff --git a/ravanan/work/command-line-tool.scm b/ravanan/work/command-line-tool.scm index b64fcad..95d69f5 100644 --- a/ravanan/work/command-line-tool.scm +++ b/ravanan/work/command-line-tool.scm @@ -38,7 +38,6 @@ unsupported-uri-scheme? unsupported-uri-scheme-scheme - value->string call-with-current-directory object-type match-type @@ -67,12 +66,6 @@ unsupported-uri-scheme unsupported-uri-scheme? (scheme unsupported-uri-scheme-scheme)) -(define (value->string x) - "Convert value @var{x} to a string." - (cond - ((number? x) (number->string x)) - (else x))) - (define (call-with-current-directory curdir thunk) "Call THUNK with current directory set to CURDIR. Restore current directory after THUNK returns." @@ -327,12 +320,12 @@ the G-expressions are inserted." (list))) ((eq? type 'null) (list)) ((cwl-array-type? type) - (match value + (match (vector->list value) ;; Empty arrays should be noops. (() (list)) - (_ + (elements (let ((args (append-map command-line-binding->args - value))) + elements))) (append (maybe->list prefix) (from-maybe (maybe-let* ((item-separator (command-line-binding-item-separator binding))) @@ -358,19 +351,33 @@ the G-expressions are inserted." @code{<command-line-binding>} objects may be strings or G-expressions. The G-expressions may reference @var{inputs} and @var{runtime} variables that must be defined in the context in which the G-expressions are inserted." + (define (value->command-line-binding position prefix value) + (let ((type (object-type value))) + (cond + ((cwl-array-type? type) + (command-line-binding position + prefix + type + (vector-map (cut value->command-line-binding + %nothing + %nothing + <>) + value) + %nothing)) + (else + (command-line-binding position prefix type value %nothing))))) + (define (argument->command-line-binding i argument) - (command-line-binding (cond - ((assoc-ref argument "position") - => string->number) - (else i)) - (maybe-assoc-ref (just argument) "prefix") - 'string - (value->string (assoc-ref* argument "valueFrom")) - %nothing)) + (value->command-line-binding (cond + ((assoc-ref argument "position") + => string->number) + (else i)) + (maybe-assoc-ref (just argument) "prefix") + (assoc-ref* argument "valueFrom"))) (define (collect-bindings ids+inputs+types+bindings) - (append-map id+input+type-tree+binding->command-line-binding - ids+inputs+types+bindings)) + (map id+input+type-tree+binding->command-line-binding + ids+inputs+types+bindings)) (define id+input+type-tree+binding->command-line-binding (match-lambda @@ -397,26 +404,25 @@ be defined in the context in which the G-expressions are inserted." ;; Recurse over array types. ;; TODO: Implement record and enum types. ((cwl-array-type? matched-type) - (list (command-line-binding - position - prefix - matched-type - (append-map (lambda (i input) - (id+input+type-tree+binding->command-line-binding - (list (append id (list i)) - input - (assoc-ref type-tree "items") - (maybe-assoc-ref (just type-tree) - "inputBinding")))) - (iota (vector-length input)) - (vector->list input)) - (maybe-assoc-ref binding "itemSeparator")))) + (command-line-binding + position + prefix + matched-type + (vector-map-indexed (lambda (i input) + (id+input+type-tree+binding->command-line-binding + (list (append id (list i)) + input + (assoc-ref type-tree "items") + (maybe-assoc-ref (just type-tree) + "inputBinding")))) + input) + (maybe-assoc-ref binding "itemSeparator"))) (else - (list (command-line-binding position - prefix - matched-type - (apply json-ref inputs id) - %nothing))))))))) + (command-line-binding position + prefix + matched-type + (apply json-ref inputs id) + %nothing)))))))) ;; For details of this algorithm, see §4.1 Input binding of the CWL ;; 1.2 CommandLineTool specification: diff --git a/ravanan/work/utils.scm b/ravanan/work/utils.scm index 9f704c3..5e057e3 100644 --- a/ravanan/work/utils.scm +++ b/ravanan/work/utils.scm @@ -70,11 +70,12 @@ mutated." (() alist))) (define (json-ref scm . keys) - "Extract subtree of JSON @var{scm} that is addressed by @var{keys}." + "Extract subtree of JSON @var{scm} that is addressed by @var{keys}. Raise an +error if any of @var{keys} is not found." (match keys ((key other-keys ...) (apply json-ref - ((if (list? scm) assoc-ref vector-ref) scm key) + ((if (list? scm) assoc-ref* vector-ref) scm key) other-keys)) (() scm))) diff --git a/ravanan/workflow.scm b/ravanan/workflow.scm index 2fd00d6..0451f68 100644 --- a/ravanan/workflow.scm +++ b/ravanan/workflow.scm @@ -279,11 +279,16 @@ command-line-tool)}." #()) (or (assoc-ref cwl "hints") #())) - (vector-map->list (lambda (input) - (let ((input-id (assoc-ref input "id"))) - (cons input-id - (json-ref step "in" input-id)))) - (assoc-ref run "inputs")) + (vector-filter-map->list (lambda (input) + (let ((input-id (assoc-ref* input "id"))) + (match (assoc input-id + (assoc-ref* step "in")) + ((_ . source) + (cons input-id source)) + ;; Optional inputs may be + ;; missing a source; drop them. + (#f #f)))) + (assoc-ref* run "inputs")) ;; Inputs that either have a default or accept null values are ;; optional. (vector-filter-map->list (lambda (input) diff --git a/tests/javascript.scm b/tests/javascript.scm index 9f86e7f..eb70373 100644 --- a/tests/javascript.scm +++ b/tests/javascript.scm @@ -46,6 +46,16 @@ (evaluate-javascript-expression "$(null)" '())) +(test-equal "evaluate true javascript expression" + #t + (evaluate-javascript-expression "$(true)" + '())) + +(test-equal "evaluate false javascript expression" + #f + (evaluate-javascript-expression "$(false)" + '())) + (test-equal "evaluate parameter reference to JSON object" (canonicalize-json '(("class" . "File") ("path" . "/foo/bar"))) @@ -81,6 +91,14 @@ ''null (gexp->sexp-rec (evaluate-javascript-expression "$(null)"))) +(test-equal "evaluate true javascript expression with node" + '#t + (gexp->sexp-rec (evaluate-javascript-expression "$(true)"))) + +(test-equal "evaluate false javascript expression with node" + '#f + (gexp->sexp-rec (evaluate-javascript-expression "$(false)"))) + (test-equal "evaluate parameter reference to JSON object using node" '(json-ref inputs "fasta") (gexp->sexp-rec @@ -178,4 +196,22 @@ (evaluate-javascript-expression "$(1 - (2 - 1))" '())) +(test-equal "evaluate javascript function body" + 2 + (evaluate-javascript-expression "${switch (inputs.message) { case \"foo\": return 1; case \"bar\": return 2; default: return 3}}" + '(("inputs" . (("message" . "bar") + ("threads" . 48))) + ("self" . #f) + ("runtime" . #f)))) + +(test-error "missing key in parameter reference must raise an error" #t + (evaluate-javascript-expression "$(inputs.fbar)" + '(("inputs" . ())) + '())) + +(test-equal "trim whitespace characters in javascript expressions" + 2 + (evaluate-javascript-expression " $(1 + 1)\n" + '())) + (test-end "javascript") diff --git a/tests/work/utils.scm b/tests/work/utils.scm new file mode 100644 index 0000000..47f99aa --- /dev/null +++ b/tests/work/utils.scm @@ -0,0 +1,29 @@ +;;; ravanan --- High-reproducibility CWL runner powered by Guix +;;; Copyright © 2025 Arun Isaac <arunisaac@systemreboot.net> +;;; +;;; This file is part of ravanan. +;;; +;;; ravanan 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. +;;; +;;; ravanan 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 ravanan. If not, see <https://www.gnu.org/licenses/>. + +(use-modules (srfi srfi-64) + (ravanan work utils)) + +(test-begin "work.utils") + +(test-error "json-ref must error out on missing keys" #t + (json-ref '(("foo" . 1) + ("bar" . (("foobar" . 3)))) + "bar" "fubar")) + +(test-end "work.command-line-tool") |