From 52f486fc3855c20f2ef092cdd17437bfc16302f6 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Sat, 18 Nov 2023 00:00:45 +0000
Subject: ccwl: Restrict #:binding parameter to YAML serializable trees.

* ccwl/ccwl.scm (ensure-yaml-serializable): Accept parameter name for
&formatted-message condition.
(input): Explicitly pass parameter name #:other. Restrict #:binding
parameter to YAML serializable trees.
*
doc/capture-output-file-with-parameter-reference.scm (extract-specific-file),
doc/capture-output-file.scm (extract),
doc/decompress-compile-run.scm (compile): Pass an YAML serializable
tree, not an expression, as the #:binding parameter.
---
 ccwl/ccwl.scm                                        | 17 ++++++++++-------
 doc/capture-output-file-with-parameter-reference.scm |  2 +-
 doc/capture-output-file.scm                          |  2 +-
 doc/decompress-compile-run.scm                       |  2 +-
 4 files changed, 13 insertions(+), 10 deletions(-)

diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm
index 3bf2644..dd4a76c 100644
--- a/ccwl/ccwl.scm
+++ b/ccwl/ccwl.scm
@@ -121,14 +121,16 @@ compared using @code{equal?}."
   (make-unspecified-default)
   unspecified-default?)
 
-(define (ensure-yaml-serializable tree)
-  "Raise an exception unless @var{tree} is serializable to YAML."
+(define (ensure-yaml-serializable tree parameter-name)
+  "Raise an exception unless @var{tree} is serializable to YAML. Use
+@var{parameter-name} in @code{&formatted-message} condition."
   ;; TODO: If tree is a quoted expression, emit a warning.
   (unless (false-if-exception
            (scm->yaml-string (syntax->datum tree)))
     (raise-exception
      (condition (ccwl-violation tree)
-                (formatted-message "#:other parameter not serializable to YAML")))))
+                (formatted-message (string-append parameter-name
+                                                  " parameter not serializable to YAML"))))))
 
 (define (construct-type-syntax type-spec)
   "Return syntax to build a type from @var{type-spec}."
@@ -186,7 +188,7 @@ compared using @code{equal?}."
                    (condition (ccwl-violation stage?)
                               (formatted-message "Invalid #:stage? parameter ~a. #:stage? must either be #t or #f."
                                                  (syntax->datum stage?)))))
-                (ensure-yaml-serializable other)
+                (ensure-yaml-serializable other "#:other")
                 (let ((position #f)
                       (prefix #f))
                   #`(make-input '#,id
@@ -244,10 +246,11 @@ compared using @code{equal?}."
                   (condition (ccwl-violation output-spec)
                              (formatted-message "Output has no identifier")))))))
        (apply (syntax-lambda** (id #:key (type #'File) binding source (other #'()))
-                (ensure-yaml-serializable other)
+                (ensure-yaml-serializable binding "#:binding")
+                (ensure-yaml-serializable other "#:other")
                 #`(make-output '#,id
                                #,(construct-type-syntax type)
-                               #,binding #,source '#,other))
+                               '#,binding #,source '#,other))
               #'(id args ...))))
     (id (identifier? #'id) (output #'(id)))
     (_ (error "Invalid output:" (syntax->datum output-spec)))))
@@ -429,7 +432,7 @@ identifiers defined in the commands."
                      (condition (ccwl-violation x)
                                 (formatted-message "Missing ~a key in command definition"
                                                    #:run))))
-                  (ensure-yaml-serializable other)
+                  (ensure-yaml-serializable other "#:other")
                   #`(make-command
                      (list #,@(map (lambda (input-spec)
                                      (let ((id (input-spec-id input-spec)))
diff --git a/doc/capture-output-file-with-parameter-reference.scm b/doc/capture-output-file-with-parameter-reference.scm
index fb32fc8..d9a0217 100644
--- a/doc/capture-output-file-with-parameter-reference.scm
+++ b/doc/capture-output-file-with-parameter-reference.scm
@@ -3,7 +3,7 @@
            #:run "tar" "--extract" "--file" archive extractfile
            #:outputs (extracted-file
                       #:type File
-                      #:binding '((glob . "$(inputs.extractfile)")))))
+                      #:binding ((glob . "$(inputs.extractfile)")))))
 
 (workflow ((archive #:type File) (extractfile #:type string))
   (extract-specific-file #:archive archive #:extractfile extractfile))
diff --git a/doc/capture-output-file.scm b/doc/capture-output-file.scm
index 2993c48..812a9a6 100644
--- a/doc/capture-output-file.scm
+++ b/doc/capture-output-file.scm
@@ -3,7 +3,7 @@
            #:run "tar" "--extract" "--file" archive
            #:outputs (extracted-file
                       #:type File
-                      #:binding '((glob . "hello.txt")))))
+                      #:binding ((glob . "hello.txt")))))
 
 (workflow ((archive #:type File))
   (extract #:archive archive))
diff --git a/doc/decompress-compile-run.scm b/doc/decompress-compile-run.scm
index 3513fd6..95bc9f8 100644
--- a/doc/decompress-compile-run.scm
+++ b/doc/decompress-compile-run.scm
@@ -8,7 +8,7 @@
            #:run "gcc" "-x" "c" source
            #:outputs (executable
                       #:type File
-                      #:binding '((glob . "a.out")))))
+                      #:binding ((glob . "a.out")))))
 
 (define run
   (command #:inputs executable
-- 
cgit v1.2.3