Improve specificity of errors in validate-txexpr

txexpr/base.rkt

@@ -85,34 +85,41 @@
       (txexpr-attr? x)
       (txexpr-attrs? x)))
 
-(define (validate-txexpr-attrs x #:context [txexpr-context #f])
+(define (validate-txexpr-attrs tx)
-  (match x
+  (andmap
-    [(list (? txexpr-attr? x) ...) x]
+   (lambda (attr)
-    [_ (raise-argument-error 'validate-txexpr-attrs
+     (unless (and (list? attr) (eq? 2 (length attr)))
-                             (string-append 
+       (txexpr-error "attribute" "is not a list of the form '(symbol \"string\")" attr tx))
-                              (if txexpr-context (format "in ~v, " txexpr-context) "")
+     (unless (symbol? (first attr))
-                              (format "list of attributes, each in the form '(symbol \"string\")")) x)]))
+       (txexpr-error "attribute key" "is not a symbol" (first attr) tx))
-
+     (unless (string? (second attr))
-
+       (txexpr-error "attribute value" "is not a string" (second attr) tx))
-(define (validate-txexpr-element x #:context [txexpr-context #f])
+     #t)
-  (unless (or (string? x) (symbol? x) (valid-char? x) (cdata? x) (txexpr? x))
+   (second tx)))
-    (raise-argument-error
+
-     'validate-txexpr-element
+(define (validate-txexpr-elements elems tx)
-     (string-append
+  (andmap
-      (if txexpr-context (format "in ~v, " txexpr-context) "")
+   (lambda (e)
-      "valid element (= txexpr, string, symbol, XML char, or cdata)") x))
+     (cond
-  x)
+       [(or (string? e) (symbol? e) (my-valid-char? e) (cdata? e)) #t]
+       [(and (list? e) (symbol? (first e)))
+        (validate-txexpr e)]
+       [else (txexpr-error "element" "not a valid element (= txexpr, string, symbol, XML char, or cdata)" e tx)]))
+   elems))
+  
+(define (txexpr-error noun has-problem bad tx)
+  (raise-arguments-error 'validate-txexpr (format "~a ~a" noun has-problem) noun bad "in" tx))
 
 ;; is it a named x-expression?
-;; todo: rewrite this recursively so errors can be pinpointed (for debugging)
+;; Restricting to primitive predicates allows for more specific (helpful) errors
 (define+provide+safe (validate-txexpr x)
   (any/c . -> . txexpr?)
-  (match x
+  (unless (list? x) (raise-argument-error 'validate-txexpr "tagged X-expression" x))
-    [(cons (? txexpr-tag?) _)
+  (unless (symbol? (car x)) (txexpr-error "tag" "must be a symbol" (car x) x))
-     (and
+  (match (rest x)
-      (validate-txexpr-attrs (get-attrs x) #:context x)
+    [(list-rest (list (? list?) attrs ...) elems)
-      (andmap (λ (e) (validate-txexpr-element e #:context x)) (get-elements x)) x)]
+     (and (validate-txexpr-attrs x) (validate-txexpr-elements elems x) x)]
-    [_ (raise-argument-error 'validate-txexpr "valid X-expression" x)]))
+    [(? list? elems) (and (validate-txexpr-elements elems x) x)]))
 
 (define (txexpr-unsafe tag attrs elements)
   (cons tag (match attrs

txexpr/scribblings/txexpr.scrbl

@@ -195,7 +195,7 @@ Predicate for functions that handle @racket[_txexpr-attrs]. Covers values that a
 (validate-txexpr
 [possible-txexpr any/c])
 txexpr?]
-Like @racket[txexpr?], but raise a descriptive error if @racket[_possible-txexpr] is invalid, and otherwise return @racket[_possible-txexpr] itself.
+Like @racket[txexpr?], but raise a descriptive error pinpointing the first problem encountered if @racket[_possible-txexpr] is invalid, and otherwise return @racket[_possible-txexpr] itself.
 
 @examples[#:eval my-eval
 (validate-txexpr 'root)
@@ -204,6 +204,8 @@ Like @racket[txexpr?], but raise a descriptive error if @racket[_possible-txexpr
 (validate-txexpr '(root ((id "top")(class "42"))))
 (validate-txexpr '(root ((id "top")(class "42")) ("hi")))
 (validate-txexpr '(root ((id "top")(class "42")) "hi"))
+(validate-txexpr '(root (p "Hello " (span [[class "inner"]] (1 2 3)))))
+(validate-txexpr `(root (p "Look out" (span ,(void)) (1 2 3))))
 ]