diff options
| -rw-r--r-- | ravanan/command-line-tool.scm | 44 | ||||
| -rw-r--r-- | ravanan/javascript.scm | 168 | ||||
| -rw-r--r-- | ravanan/work/command-line-tool.scm | 20 | ||||
| -rw-r--r-- | tests/javascript.scm | 54 |
4 files changed, 138 insertions, 148 deletions
diff --git a/ravanan/command-line-tool.scm b/ravanan/command-line-tool.scm index a789079..54a92cf 100644 --- a/ravanan/command-line-tool.scm +++ b/ravanan/command-line-tool.scm @@ -27,7 +27,6 @@ #:use-module (ice-9 match) #:use-module ((gnu packages gnupg) #:select (guile-gcrypt)) #:use-module ((gnu packages guile-xyz) #:select (guile-filesystem)) - #:use-module ((gnu packages node) #:select (node)) #:use-module (guix derivations) #:use-module (guix gexp) #:use-module (guix modules) @@ -36,7 +35,6 @@ #:use-module (guix search-paths) #:use-module (guix store) #:use-module (json) - #:use-module (ravanan config) #:use-module (ravanan javascript) #:use-module (ravanan job-state) #:use-module (ravanan reader) @@ -85,10 +83,6 @@ (else (assertion-violation batch-system "Unknown batch system")))) -;; node executable for evaluating javascript on worker nodes -(define %worker-node - (file-append node "/bin/node")) - (define-immutable-record-type <formal-output> (formal-output id type binding) formal-output? @@ -168,22 +162,6 @@ class. Else, return @code{#f}." @code{#f}." (string-contains str "$(")) -(define (interpolate-parameter-references str) - "Interpolate @var{str} with one or more parameter references into a javascript -expression suitable for evaluation." - (string-join (map (lambda (token) - (if (and (string-prefix? "$(" token) - (string-suffix? ")" token)) - ;; Strip $(…). - (substring token - (string-length "$(") - (- (string-length token) - (string-length ")"))) - ;; Surround with double quotes. - (string-append "\"" token "\""))) - (tokenize-parameter-references str)) - " + ")) - (define* (coerce-expression expression #:optional context) "Coerce @var{expression} into a scheme JSON tree. @@ -197,26 +175,8 @@ context and return the value. @var{context} must be an association list with keys @code{input}, @code{self} and @code{runtime}." (if (and (string? expression) (javascript-expression? expression)) - (from-maybe - ;; Try evaluating expression as a simple parameter reference that uses a - ;; subset of javascript. - (evaluate-simple-parameter-reference expression context) - ;; Perhaps this is a more complex javascript expression. Fall back to node. - (if context - ;; Evaluate immediately. - (evaluate-parameter-reference %node - (interpolate-parameter-references expression) - (assq-ref context 'inputs) - 'null - (list) - (list)) - ;; Compile to a G-expression that evaluates expression. - #~(evaluate-parameter-reference #$%worker-node - #$(interpolate-parameter-references expression) - inputs - 'null - runtime - (list)))) + ;; Evaluate javascript expression. + (evaluate-parameter-reference expression context) ;; Not a javascript expression, but some other JSON tree. Return it as is. expression)) diff --git a/ravanan/javascript.scm b/ravanan/javascript.scm index ad65828..47846df 100644 --- a/ravanan/javascript.scm +++ b/ravanan/javascript.scm @@ -20,7 +20,8 @@ ;; CWL allows parameter references that use a subset of Javascript/ECMAScript ;; 5.1 syntax. This module implements that subset in scheme without resorting to -;; a full-blown javascript engine. +;; a full-blown javascript engine. In addition, it provides a fallback to the +;; node javascript engine for more complex expressions. ;;; Code: @@ -28,13 +29,18 @@ #:use-module (srfi srfi-1) #:use-module (ice-9 match) #:use-module (ice-9 peg) + #:use-module ((gnu packages node) #:select (node)) #:use-module (guix gexp) #:use-module (json) - #:use-module (ravanan work monads) + #:use-module (ravanan config) + #:use-module (ravanan work command-line-tool) #:use-module (ravanan work ui) #:use-module (ravanan work utils) - #:export (evaluate-simple-parameter-reference - tokenize-parameter-references)) + #:export (evaluate-parameter-reference)) + +;; node executable for evaluating javascript on worker nodes +(define %worker-node + (file-append node "/bin/node")) (define-peg-pattern symbol body (+ (or (range #\a #\z) @@ -65,45 +71,75 @@ (define-peg-pattern parameter-reference all (and (ignore "(") symbol (* segment) (ignore ")"))) -(define* (evaluate-parameter-reference-1 expression context) - "Compile parameter reference @var{expression} to a G-expression that references -the variables @code{inputs}, @code{self} or @code{runtime}. @var{expression} -must strictly be a single parameter reference and will not be subject to string -interpolation. +(define* (evaluate-parameter-reference-1 expression context expression-lib) + "Compile parameter reference @var{expression} to a G-expression that evaluates +it. The returned G-expression may reference the variables @code{inputs}, +@code{self} or @code{runtime}. @var{expression} must strictly be a single +parameter reference and will not be subject to string interpolation. If @var{context} is not @code{#f}, evaluate the parameter reference in that context and return the value. @var{context} must be an association list with keys @code{\"inputs\"}, @code{\"self\"} and @code{\"runtime\"}. -The returned value is maybe-monadic. If @var{expression} fails to parse, -@code{Nothing} is returned." - (match (peg:tree (match-pattern parameter-reference expression)) - ;; Special case for null - (('parameter-reference "null") - (just (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 and produce a G-expression. 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. - (('parameter-reference symbol . (or (('segment segments) ...) - ((('segment segments) ...)))) - (let ((segments (map (match-lambda - (('index key) (string->number key)) - (key key)) - segments))) - (just (if context - (apply json-ref context symbol segments) - #~(json-ref #$symbol #$@segments))))) - ;; Perhaps this is a more complex javascript expression. - (#f %nothing))) +@var{expression-lib} is a list of expressions evaluated before evaluating +@var{expression}." + (match expression-lib + (() + (match (peg:tree (match-pattern parameter-reference expression)) + ;; 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 and produce a G-expression. 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. + (('parameter-reference symbol . (or (('segment segments) ...) + ((('segment segments) ...)))) + (let ((segments (map (match-lambda + (('index key) (string->number key)) + (key key)) + segments))) + (if context + ;; Evaluate immediately. + (apply json-ref context symbol segments) + ;; Compile to a G-expression that evaluates expression. + #~(json-ref #$symbol #$@segments)))) + ;; Perhaps this is a more complex javascript expression. + (#f + (evaluate-using-node expression context expression-lib)))) + ;; expression-lib has been provided. Fall back to node. + (_ + (evaluate-using-node expression context expression-lib)))) + +(define (evaluate-using-node expression context expression-lib) + "This function is the same as @code{evaluate-parameter-reference-1} but uses +the node javascript engine." + (define (set-variable name value) + (string-append name " = " (scm->json-string value) ";")) + + (define preamble + (string-join (append expression-lib + (filter-map (match-lambda + (((and (or "inputs" "self" "runtime") + name) + . value) + (set-variable name value)) + (_ #f)) + context)))) + + (if context + ;; Evaluate immediately. + (evaluate-javascript %node expression preamble) + ;; Compile to a G-expression that evaluates expression. + #~(evaluate-javascript #$%worker-node #$expression #$preamble))) (define (tokenize-parameter-references str) "Split @var{str} into tokens of parameter reference and literal strings." @@ -117,7 +153,7 @@ The returned value is maybe-monadic. If @var{expression} fails to parse, (list) (list str))))) -(define* (evaluate-simple-parameter-reference str #:optional context) +(define* (evaluate-parameter-reference str #:optional context (expression-lib '())) "Compile parameter reference @var{str} to a G-expression that references the variables @code{inputs}, @code{self} or @code{runtime}. @var{str} may be subject to string interpolation. @@ -126,37 +162,33 @@ If @var{context} is not @code{#f}, evaluate the parameter reference in that context and return the value. @var{context} must be an association list with keys @code{\"inputs\"}, @code{\"self\"} and @code{\"runtime\"}. -The returned value is maybe-monadic. If any of the parameter references in -@var{str} fail to parse, @code{Nothing} is returned." +@var{expression-lib} is a list of expressions evaluated before evaluating +@var{expression}." (define (evaluate-token token) (if (and (string-prefix? "$(" token) (string-suffix? ")" token)) ;; Drop the leading "$" and evaluate. - (evaluate-simple-parameter-reference-1 (string-drop token 1) - context) + (evaluate-parameter-reference-1 (string-drop token 1) + context + expression-lib) ;; token is a string literal. - (just token))) - - (maybe-let* ((evaluated-tokens - (fold (lambda (token maybe-result) - (maybe-let* ((result maybe-result)) - (maybe-let* ((evaluated-token (evaluate-token token))) - (just (cons evaluated-token result))))) - (just (list)) - (tokenize-parameter-references str)))) - (just (if context - ;; Evaluate immediately. - (string-join (map (lambda (token) - (if (string? token) - token - (scm->json-string (canonicalize-json token)))) - (reverse evaluated-tokens)) - "") - ;; Compile to a G-expression that interpolates parameter reference - ;; string. - #~(string-join (map (lambda (token) - (if (string? token) - token - (scm->json-string (canonicalize-json token)))) - (list #$@(reverse evaluated-tokens))) - ""))))) + token)) + + (let ((evaluated-tokens (map evaluate-token + (tokenize-parameter-references str)))) + (if context + ;; Evaluate immediately. + (string-join (map (lambda (token) + (if (string? token) + token + (scm->json-string (canonicalize-json token)))) + evaluated-tokens) + "") + ;; Compile to a G-expression that interpolates parameter reference + ;; string. + #~(string-join (map (lambda (token) + (if (string? token) + token + (scm->json-string (canonicalize-json token)))) + (list #$@evaluated-tokens)) + "")))) diff --git a/ravanan/work/command-line-tool.scm b/ravanan/work/command-line-tool.scm index a334285..4787e3d 100644 --- a/ravanan/work/command-line-tool.scm +++ b/ravanan/work/command-line-tool.scm @@ -36,8 +36,7 @@ run-command sha1-hash checksum - evaluate-javascript - evaluate-parameter-reference)) + evaluate-javascript)) (define (value->string x) "Convert value @var{x} to a string." @@ -206,20 +205,3 @@ status in @var{success-codes} as success. Error out otherwise." (format #f "--eval=~a console.log(\"%j\", ~a)" preamble expression)) json->scm))) - -(define (evaluate-parameter-reference node expression inputs self runtime expression-lib) - "Evaluate parameter reference @var{expression} using -@var{node}. @var{inputs}, @var{self} and @var{runtime} provide the -context in which @var{expression} is evaluated. @var{expression-lib} -is a list of expressions evaluated before evaluating @var{expression}." - (define (set-variable name value) - (format #f "~a = ~a;" - name - (scm->json-string value))) - - (evaluate-javascript node - expression - (string-join (append expression-lib - (list (set-variable "inputs" inputs) - (set-variable "self" self) - (set-variable "runtime" runtime)))))) diff --git a/tests/javascript.scm b/tests/javascript.scm index 5f23153..b6c4753 100644 --- a/tests/javascript.scm +++ b/tests/javascript.scm @@ -24,30 +24,46 @@ (test-equal "evaluate parameter reference" "c" - (from-maybe - (evaluate-simple-parameter-reference "$(inputs.message['bar'][\"foo\"][2])" - '(("inputs" ("message" ("bar" ("foo" . #("a" "b" "c" "d"))))))) - #f)) + (evaluate-parameter-reference "$(inputs.message['bar'][\"foo\"][2])" + '(("inputs" ("message" ("bar" ("foo" . #("a" "b" "c" "d")))))))) (test-equal "evaluate parameter reference with string interpolation" "24foo12foobar" - (from-maybe - (evaluate-simple-parameter-reference "$(runtime.cores)foo$(inputs.threads)$(inputs.output_filename)" - '(("inputs" - ("threads" . 12) - ("output_filename" . "foobar")) - ("runtime" ("cores" . 24)))) - #f)) + (evaluate-parameter-reference "$(runtime.cores)foo$(inputs.threads)$(inputs.output_filename)" + '(("inputs" + ("threads" . 12) + ("output_filename" . "foobar")) + ("runtime" ("cores" . 24))))) (test-equal "evaluate parameter reference with string interpolation of JSON trees" "foo[0,1,2,3]{\"bar\":2,\"foo\":1}" - (from-maybe - (evaluate-simple-parameter-reference "foo$(inputs.vector)$(inputs.object)" - '(("inputs" - ("object" - ("foo" . 1) - ("bar" . 2)) - ("vector" . #(0 1 2 3))))) - #f)) + (evaluate-parameter-reference "foo$(inputs.vector)$(inputs.object)" + '(("inputs" + ("object" + ("foo" . 1) + ("bar" . 2)) + ("vector" . #(0 1 2 3)))))) + +(test-equal "evaluate parameter reference with node" + "3" + (evaluate-parameter-reference "$(inputs.n + 1)" + '(("inputs" ("n" . 2))))) + +(test-equal "evaluate parameter reference with string interpolation using node" + "24foo24foobar" + (evaluate-parameter-reference "$(runtime.cores)foo$(inputs.threads*2)$(inputs.output_filename)" + '(("inputs" + ("threads" . 12) + ("output_filename" . "foobar")) + ("runtime" ("cores" . 24))))) + +(test-equal "evaluate parameter reference with string interpolation of JSON trees using node" + "foo[0,1,2,3]{\"bar\":2,\"foo\":1}20" + (evaluate-parameter-reference "foo$(inputs.vector)$(inputs.object)$(inputs.object.foo*20)" + '(("inputs" + ("object" + ("foo" . 1) + ("bar" . 2)) + ("vector" . #(0 1 2 3)))))) (test-end "javascript") |