ccwl: Report non-existent external CWL workflow files.

cwl-workflow needs to be a macro so we have access to syntax objects
necessary to raise a &cwl-violation condition.

* ccwl/ccwl.scm (cwl-workflow): Rewrite as macro. Report error if CWL
file does not exist.

1 files changed, 43 insertions, 32 deletions

diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm
index 0b8f701..429bbed 100644
--- a/ccwl/ccwl.scm
+++ b/ccwl/ccwl.scm
@@ -463,38 +463,49 @@ identifiers defined in the commands."
                      '#,other))
                 #'(args ...)))))))
 
-(define (cwl-workflow file)
-  (define (parameters->id+type parameters)
-    (if (vector? parameters)
-        ;; Vector of dictionaries
-        (map (lambda (alist)
-               (cons (string->symbol (assoc-ref alist "id"))
-                     (string->symbol (assoc-ref alist "type"))))
-             (vector->list parameters))
-        ;; One dictionary
-        (map (match-lambda
-               ((id . (? string? type))
-                (cons (string->symbol id)
-                      (string->symbol type)))
-               ((id . alist)
-                (cons (string->symbol id)
-                      (string->symbol (assoc-ref alist "type")))))
-             parameters)))
-
-  (unless (file-exists? file)
-    (error "CWL workflow file does not exist" file))
-  ;; Read inputs/outputs from CWL workflow YAML file and build a
-  ;; <cwl-workflow> object.
-  (let ((yaml (read-yaml-file file)))
-    (make-cwl-workflow file
-                       (map (match-lambda
-                              ((id . type)
-                               (make-input id type #f #f #f #f #f #f)))
-                            (parameters->id+type (assoc-ref yaml "inputs")))
-                       (map (match-lambda
-                              ((id . type)
-                               (make-output id type #f #f #f)))
-                            (parameters->id+type (assoc-ref yaml "outputs"))))))
+(define-syntax cwl-workflow
+  (lambda (x)
+    (syntax-case x ()
+      ((_ file-syntax)
+       (let ((file (syntax->datum #'file-syntax))
+             (parameters->id+type
+              (lambda (parameters)
+                (if (vector? parameters)
+                    ;; Vector of dictionaries
+                    (map (lambda (alist)
+                           (cons (string->symbol (assoc-ref alist "id"))
+                                 (string->symbol (assoc-ref alist "type"))))
+                         (vector->list parameters))
+                    ;; One dictionary
+                    (map (match-lambda
+                           ((id . (? string? type))
+                            (cons (string->symbol id)
+                                  (string->symbol type)))
+                           ((id . alist)
+                            (cons (string->symbol id)
+                                  (string->symbol (assoc-ref alist "type")))))
+                         parameters)))))
+         (unless (file-exists? file)
+           (raise-exception
+            (condition (ccwl-violation #'file-syntax)
+                       (formatted-message "CWL workflow file ~a does not exist" file))))
+         ;; Read inputs/outputs from CWL workflow YAML file and build
+         ;; a <cwl-workflow> object.
+         (let ((yaml (read-yaml-file file)))
+           #`(make-cwl-workflow
+              file-syntax
+              (list #,@(map (match-lambda
+                             ((id . type)
+                              (with-syntax ((id (datum->syntax #f id))
+                                            (type (datum->syntax #f type)))
+                                #`(make-input 'id 'type #f #f #f #f #f #f))))
+                           (parameters->id+type (assoc-ref yaml "inputs"))))
+              (list #,@(map (match-lambda
+                             ((id . type)
+                              (with-syntax ((id (datum->syntax #f id))
+                                            (type (datum->syntax #f type)))
+                                #`(make-output 'id 'type #f #f #f))))
+                           (parameters->id+type (assoc-ref yaml "outputs")))))))))))
 
 (define (function-inputs function)
   "Return the list of inputs accepted by @var{function}---a