From e12759ce31a746b0532fbb13371579f0aa19b518 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Sun, 16 Jan 2022 13:01:25 +0530
Subject: ccwl: Raise exceptions on command syntax errors.

* ccwl/ccwl.scm (command): Raise &ccwl-violation conditions on syntax
errors.
* tests/ccwl.scm ("command, when passed positional arguments, must
raise a &ccwl-violation condition", "command, when passed an
unrecognized keyword, must raise a &ccwl-violation condition",
"command, when passed multiple arguments to a unary keyword, must
raise a &ccwl-violation condition"): New tests.
---
 ccwl/ccwl.scm  | 92 ++++++++++++++++++++++++++++++++++++++--------------------
 tests/ccwl.scm | 26 +++++++++++++++++
 2 files changed, 87 insertions(+), 31 deletions(-)

diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm
index c366d3d..bff51f4 100644
--- a/ccwl/ccwl.scm
+++ b/ccwl/ccwl.scm
@@ -273,37 +273,67 @@ RUN-ARGS. If such an input is not present in RUN-ARGS, return #f."
   (lambda (x)
     (syntax-case x ()
       ((_ args ...)
-       (apply (syntax-lambda** (#:key stdin #:key* inputs outputs run other)
-                (unless run
-                  (error "#:run key required in command definition" (syntax->datum x)))
-                #`(make-command
-                   (list #,@(map (lambda (input-spec)
-                                   (let ((id (input-spec-id input-spec)))
-                                     #`(set-input-prefix
-                                        (set-input-position #,(input input-spec)
-                                                            #,(run-arg-position id run))
-                                        #,(run-arg-prefix id run))))
-                                 inputs))
-                   (list #,@(map output outputs))
-                   (list #,@(map (lambda (x)
-                                   (syntax-case x ()
-                                     ;; Replace input symbol with quoted symbol.
-                                     (input (identifier? #'input)
-                                      #''input)
-                                     ;; Leave string as is.
-                                     (string-arg (string? (syntax->datum #'string-arg))
-                                      #'string-arg)
-                                     ;; Replace prefixed input symbol with
-                                     ;; quoted symbol.
-                                     ((prefix input) (and (string? (syntax->datum #'prefix))
-                                                          (identifier? #'input))
-                                      #''input)
-                                     (_ (error "Invalid command element:"
-                                               (syntax->datum x)))))
-                                 run))
-                   #,(and stdin #`'#,stdin)
-                   (list #,@other)))
-              #'(args ...))))))
+       (guard (exception
+               ((unrecognized-keyword-assertion? exception)
+                (raise-exception
+                 (match (condition-irritants exception)
+                   ((irritant _ ...)
+                    (condition (ccwl-violation irritant)
+                               (formatted-message "Unrecognized keyword argument ~a in command definition"
+                                                  (syntax->datum irritant)))))))
+               ((invalid-keyword-arity-assertion? exception)
+                (raise-exception
+                 (match (condition-irritants exception)
+                   ;; TODO: Report all extra arguments, not just the
+                   ;; first one.
+                   ((keyword _ extra _ ...)
+                    (condition (ccwl-violation extra)
+                               (formatted-message "Unexpected extra argument ~a for unary keyword argument ~a"
+                                                  (syntax->datum extra)
+                                                  (syntax->datum keyword)))))))
+               ((invalid-positional-arguments-arity-assertion? exception)
+                (raise-exception
+                 (match (condition-irritants exception)
+                   ;; TODO: Report all extra positional arguments, not
+                   ;; just the first one.
+                   ((extra _ ...)
+                    (condition (ccwl-violation extra)
+                               (formatted-message "Unexpected extra positional argument ~a in command definition"
+                                                  (syntax->datum extra))))))))
+         (apply (syntax-lambda** (#:key stdin #:key* inputs outputs run other)
+                  (when (null? run)
+                    (raise-exception
+                     (condition (ccwl-violation x)
+                                (formatted-message "Missing ~a key in command definition"
+                                                   #:run))))
+                  #`(make-command
+                     (list #,@(map (lambda (input-spec)
+                                     (let ((id (input-spec-id input-spec)))
+                                       #`(set-input-prefix
+                                          (set-input-position #,(input input-spec)
+                                                              #,(run-arg-position id run))
+                                          #,(run-arg-prefix id run))))
+                                   inputs))
+                     (list #,@(map output outputs))
+                     (list #,@(map (lambda (x)
+                                     (syntax-case x ()
+                                       ;; Replace input symbol with quoted symbol.
+                                       (input (identifier? #'input)
+                                              #''input)
+                                       ;; Leave string as is.
+                                       (string-arg (string? (syntax->datum #'string-arg))
+                                                   #'string-arg)
+                                       ;; Replace prefixed input symbol with
+                                       ;; quoted symbol.
+                                       ((prefix input) (and (string? (syntax->datum #'prefix))
+                                                            (identifier? #'input))
+                                        #''input)
+                                       (_ (error "Invalid command element:"
+                                                 (syntax->datum x)))))
+                                   run))
+                     #,(and stdin #`'#,stdin)
+                     (list #,@other)))
+                #'(args ...)))))))
 
 (define (cwl-workflow file)
   (define (parameters->id+type parameters)
diff --git a/tests/ccwl.scm b/tests/ccwl.scm
index d667b32..d99650e 100644
--- a/tests/ccwl.scm
+++ b/tests/ccwl.scm
@@ -85,4 +85,30 @@
           (else (ccwl-violation? exception)))
     (output #'(message #:type int string))))
 
+(test-assert "command, when passed positional arguments, must raise a &ccwl-violation condition"
+  (guard (exception
+          (else (ccwl-violation? exception)))
+    (macroexpand
+     '(command foo
+               #:inputs (message #:type string)
+               #:run "echo" message
+               #:outputs (stdout #:type stdout)))))
+
+(test-assert "command, when passed an unrecognized keyword, must raise a &ccwl-violation condition"
+  (guard (exception
+          (else (ccwl-violation? exception)))
+    (macroexpand
+     '(command #:foo (message #:type string)
+               #:run "echo" message
+               #:outputs (stdout #:type stdout)))))
+
+(test-assert "command, when passed multiple arguments to a unary keyword, must raise a &ccwl-violation condition"
+  (guard (exception
+          (else (ccwl-violation? exception)))
+    (macroexpand
+     '(command #:inputs (message #:type string)
+               #:run "echo" message
+               #:outputs (stdout #:type stdout)
+               #:stdin "foo" "bar"))))
+
 (test-end "ccwl")
-- 
cgit v1.2.3