mbutterick
/
txexpr
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Improve specificity of errors in validate-txexpr (#15)

Browse Source
master
Joel Dueck 4 years ago committed by GitHub
parent 6b15b86f99
commit 435c6e6f36
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 107 additions and 26 deletions
Show Stats Download Patch File Download Diff File

55
txexpr/base.rkt
Unescape Escape View File

@ -85,34 +85,41 @@
(txexpr-attr? x)
(txexpr-attrs? x)))
(define (validate-txexpr-attrs x #:context [txexpr-context #f])
(match x
[(list (? txexpr-attr? x) ...) x]
[_ (raise-argument-error 'validate-txexpr-attrs
(string-append
(if txexpr-context (format "in ~v, " txexpr-context) "")
(format "list of attributes, each in the form '(symbol \"string\")")) x)]))
(define (validate-txexpr-element x #:context [txexpr-context #f])
(unless (or (string? x) (symbol? x) (valid-char? x) (cdata? x) (txexpr? x))
(raise-argument-error
'validate-txexpr-element
(string-append
(if txexpr-context (format "in ~v, " txexpr-context) "")
"valid element (= txexpr, string, symbol, XML char, or cdata)") x))
x)
(define (validate-txexpr-attrs tx)
(andmap
(lambda (attr)
(unless (and (list? attr) (eq? 2 (length attr)))
(txexpr-error "attribute" "is not a list of the form '(symbol \"string\")" attr tx))
(unless (symbol? (first attr))
(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))
#t)
(second tx)))
(define (validate-txexpr-elements elems tx)
(andmap
(lambda (e)
(cond
[(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
[(cons (? txexpr-tag?) _)
(and
(validate-txexpr-attrs (get-attrs x) #:context x)
(andmap (λ (e) (validate-txexpr-element e #:context x)) (get-elements x)) x)]
[_ (raise-argument-error 'validate-txexpr "valid X-expression" x)]))
(unless (list? x) (raise-argument-error 'validate-txexpr "tagged X-expression" x))
(unless (symbol? (car x)) (txexpr-error "tag" "must be a symbol" (car x) x))
(match (rest x)
[(list-rest (list (? list?) attrs ...) elems)
(and (validate-txexpr-attrs x) (validate-txexpr-elements elems x) x)]
[(? list? elems) (and (validate-txexpr-elements elems x) x)]))
(define (txexpr-unsafe tag attrs elements)
(cons tag (match attrs

4
txexpr/scribblings/txexpr.scrbl
Unescape Escape View File

@ -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))))
]

74
txexpr/test/tests.rkt
Unescape Escape View File

@ -71,7 +71,79 @@
(check-exn exn:fail? (λ _ (validate-txexpr '(p "foo" "bar" ((key "value")))))) ; malformed
(check-exn exn:fail? (λ _ (validate-txexpr '("p" "foo" "bar")))) ; no name
(check-exn exn:fail? (λ _ (validate-txexpr '(root ((id "top")(class 42)))))) ; malformed attrs
(check-exn exn:fail? (λ _ (validate-txexpr `(root ,(void))))) ; invalid element type
(define-syntax (check-validate-exn-msg stx)
(syntax-case stx ()
[(_ tx) (syntax/loc stx (check-validate-exn-msg tx ""))]
[(_ tx msg)
(syntax/loc stx
(check-equal? (with-handlers ([exn:fail:contract? (λ (e) (exn-message e))])
(validate-txexpr tx)) msg))]))
;; Root element not a list
(check-validate-exn-msg
"foo"
"validate-txexpr: contract violation\n expected: tagged X-expression\n given: \"foo\"")
;; No name
(check-validate-exn-msg
'("p" "foo" "bar")
"validate-txexpr: tag must be a symbol\n tag: \"p\"\n in: '(\"p\" \"foo\" \"bar\")")
;; Invalid element
(check-validate-exn-msg
'(p "foo" "bar" ((key "value")))
"validate-txexpr: element not a valid element (= txexpr, string, symbol, XML char, or cdata)\n element: '((key \"value\"))\n in: '(p \"foo\" \"bar\" ((key \"value\")))")
;; Malformed attribute list
(check-validate-exn-msg
'(p ((key "val") "foo" "bar") "hi")
"validate-txexpr: attribute is not a list of the form '(symbol \"string\")\n attribute: \"foo\"\n in: '(p ((key \"val\") \"foo\" \"bar\") \"hi\")")
;; Invalid attribute key
(check-validate-exn-msg
'(root ((id "top") (class 42)))
"validate-txexpr: attribute value is not a string\n attribute value: 42\n in: '(root ((id \"top\") (class 42)))")
;; Invalid attribute value
(check-validate-exn-msg
'(root ((id "top") ("class" 42)))
"validate-txexpr: attribute key is not a symbol\n attribute key: \"class\"\n in: '(root ((id \"top\") (\"class\" 42)))")
;; Invalid element type
(check-validate-exn-msg
`(root ,(void))
"validate-txexpr: element not a valid element (= txexpr, string, symbol, XML char, or cdata)\n element: #<void>\n in: '(root #<void>)")
;; (Deeply nested) No name: error should pinpoint element in 'div txexpr
(check-validate-exn-msg
'(fine-outer [[type "valid"]] (div (br) ("p" "foo" "bar")))
"validate-txexpr: element not a valid element (= txexpr, string, symbol, XML char, or cdata)\n element: '(\"p\" \"foo\" \"bar\")\n in: '(div (br) (\"p\" \"foo\" \"bar\"))")
;; (Deeply nested) Invalid element: error should pinpoint element in 'p txexpr
(check-validate-exn-msg
'(fine-outer [[type "valid"]] (div (br) (p "foo" "bar" ((key "value")))))
"validate-txexpr: element not a valid element (= txexpr, string, symbol, XML char, or cdata)\n element: '((key \"value\"))\n in: '(p \"foo\" \"bar\" ((key \"value\")))")
;; (Deeply nested) Malformed attribute list: error should pinpoint attr in 'p txexpr
(check-validate-exn-msg
'(fine-outer [[type "valid"]] (div (br) (p ((key "val") "foo" "bar") "hi")))
"validate-txexpr: attribute is not a list of the form '(symbol \"string\")\n attribute: \"foo\"\n in: '(p ((key \"val\") \"foo\" \"bar\") \"hi\")")
;; (Deeply nested) Invalid attribute key: error should pinpoint attr key in 'p txexpr
(check-validate-exn-msg
'(fine-outer [[type "valid"]] (div (br) (p ((id "top") (class 42)))))
"validate-txexpr: attribute value is not a string\n attribute value: 42\n in: '(p ((id \"top\") (class 42)))")
;; (Deeply nested) Invalid attribute value: error should pinpoint attr val in 'p txexpr
(check-validate-exn-msg
'(fine-outer [[type "valid"]] (div (br) (p ((id "top") ("class" 42)))))
"validate-txexpr: attribute key is not a symbol\n attribute key: \"class\"\n in: '(p ((id \"top\") (\"class\" 42)))")
;; (Deeply nested) Invalid element type: error should pinpoint element in 'p txexpr
(check-validate-exn-msg
`(fine-outer [[type "valid"]] (div (br) (p ,(void))))
"validate-txexpr: element not a valid element (= txexpr, string, symbol, XML char, or cdata)\n element: #<void>\n in: '(p #<void>)")
(check-txexprs-equal? (make-txexpr 'p) '(p))
(check-txexprs-equal? (make-txexpr 'p '((key "value"))) '(p ((key "value"))))

Write Preview
Loading…
Cancel
Save