From 7dd1d5f59ddda260eb86124eb4381cc726d706f7 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Fri, 15 Jan 2016 10:01:07 -0800
Subject: [PATCH] add `findf-txexpr` and `findf*-txexpr`

---
 main.rkt                 | 12 ++++++++++++
 scribblings/txexpr.scrbl | 27 +++++++++++++++++++++++++++
 tests.rkt                |  8 +++++++-
 3 files changed, 46 insertions(+), 1 deletion(-)

diff --git a/main.rkt b/main.rkt
index 601b384..53fcca4 100644
--- a/main.rkt
+++ b/main.rkt
@@ -346,6 +346,18 @@
               (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)
   (xexpr? . -> . string?)
   (define (->cdata x)
diff --git a/scribblings/txexpr.scrbl b/scribblings/txexpr.scrbl
index f8f9dc3..1d5f249 100644
--- a/scribblings/txexpr.scrbl
+++ b/scribblings/txexpr.scrbl
@@ -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[
 (check-txexprs-equal?
 [tx1 txexpr?]
diff --git a/tests.rkt b/tests.rkt
index 91ad340..e3e7f32 100644
--- a/tests.rkt
+++ b/tests.rkt
@@ -196,13 +196,19 @@
  
  (define split-this-tx '(root (meta "foo" "bar") "hello" "world" (meta "foo2" "bar2") 
                               (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) 
                        (list '(root "hello" "world" (em "goodnight" "moon")) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3"))))
  
  (define split-proc (λ(x) '(div "foo")))
  (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"))))
+
+ (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?"))
                "<root><script>3 > 2</script>Why is 3 &gt; 2?</root>"))
\ No newline at end of file