add `findf-txexpr` and `findf*-txexpr`

dev-fixit
Matthew Butterick 9 years ago
parent 5cb2d6d93e
commit 7dd1d5f59d

@ -346,6 +346,18 @@
(error 'splitf-txexpr "Bad input")) (reverse matches))) (error 'splitf-txexpr "Bad input")) (reverse matches)))
(define+provide+safe (findf*-txexpr tx pred)
(txexpr? procedure? . -> . (or/c #f txexpr-elements?))
(define-values (_ matches) (splitf-txexpr tx pred))
(and (pair? matches) matches))
(define+provide+safe (findf-txexpr tx pred)
(txexpr? procedure? . -> . (or/c #f txexpr-element?))
(define matches (findf*-txexpr tx pred))
(and matches (car matches)))
(define+provide+safe (xexpr->html x) (define+provide+safe (xexpr->html x)
(xexpr? . -> . string?) (xexpr? . -> . string?)
(define (->cdata x) (define (->cdata x)

@ -525,6 +525,33 @@ Ordinarily, the result of the split operation is to remove the elements that mat
] ]
@deftogether[(
@defproc[
(findf*-txexpr
[tx txexpr?]
[pred procedure?])
(or/c #f (listof txexpr-element?))]
@defproc[
(findf-txexpr
[tx txexpr?]
[pred procedure?])
(or/c #f txexpr-element?)]
)]
Like @racket[splitf-txexpr], but only retrieve the elements that match @racket[_pred]. @racket[findf*-txexpr] retrieves all results; @racket[findf-txexpr] only the first. In both cases, if there are no matches, you get @racket[#f].
@examples[#:eval my-eval
(define tx '(div "Wonderful day" (meta "weather" "good")
"for a walk" (meta "dog" "Roxy")))
(define is-meta? (λ(x) (and (txexpr? x) (eq? 'meta (get-tag x)))))
(findf*-txexpr tx is-meta?)
(findf-txexpr tx is-meta?)
(define is-zimzam? (λ(x) (and (txexpr? x) (eq? 'zimzam (get-tag x)))))
(findf*-txexpr tx is-zimzam?)
(findf-txexpr tx is-zimzam?)
]
@defproc[ @defproc[
(check-txexprs-equal? (check-txexprs-equal?
[tx1 txexpr?] [tx1 txexpr?]

@ -196,13 +196,19 @@
(define split-this-tx '(root (meta "foo" "bar") "hello" "world" (meta "foo2" "bar2") (define split-this-tx '(root (meta "foo" "bar") "hello" "world" (meta "foo2" "bar2")
(em "goodnight" "moon" (meta "foo3" "bar3")))) (em "goodnight" "moon" (meta "foo3" "bar3"))))
(define split-predicate (λ(x) (and (txexpr? x) (equal? 'meta (car x))))) (define split-predicate (λ(x) (and (txexpr? x) (eq? 'meta (get-tag x)))))
(check-txexprs-equal? (call-with-values (λ() (splitf-txexpr split-this-tx split-predicate)) list) (check-txexprs-equal? (call-with-values (λ() (splitf-txexpr split-this-tx split-predicate)) list)
(list '(root "hello" "world" (em "goodnight" "moon")) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3")))) (list '(root "hello" "world" (em "goodnight" "moon")) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3"))))
(define split-proc (λ(x) '(div "foo"))) (define split-proc (λ(x) '(div "foo")))
(check-txexprs-equal? (call-with-values (λ() (splitf-txexpr split-this-tx split-predicate split-proc)) list) (check-txexprs-equal? (call-with-values (λ() (splitf-txexpr split-this-tx split-predicate split-proc)) list)
(list '(root (div "foo") "hello" "world" (div "foo") (em "goodnight" "moon" (div "foo"))) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3")))) (list '(root (div "foo") "hello" "world" (div "foo") (em "goodnight" "moon" (div "foo"))) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3"))))
(define false-pred (λ(x) (and (txexpr? x) (eq? 'nonexistent-tag (get-tag x)))))
(check-equal? (findf*-txexpr split-this-tx split-predicate) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3")))
(check-false (findf*-txexpr split-this-tx false-pred))
(check-equal? (findf-txexpr split-this-tx split-predicate) '(meta "foo" "bar"))
(check-false (findf-txexpr split-this-tx false-pred))
(check-equal? (xexpr->html '(root (script "3 > 2") "Why is 3 > 2?")) (check-equal? (xexpr->html '(root (script "3 > 2") "Why is 3 > 2?"))
"<root><script>3 > 2</script>Why is 3 &gt; 2?</root>")) "<root><script>3 > 2</script>Why is 3 &gt; 2?</root>"))
Loading…
Cancel
Save