From 96785afac55677f20ee435049c87369c6fd5d7bf Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Wed, 6 May 2015 17:50:37 -0700
Subject: [PATCH] add #:exclude-attrs to `decode`

---
 decode.rkt               | 17 +++++++++++------
 scribblings/decode.scrbl | 24 ++++++++++++++++--------
 2 files changed, 27 insertions(+), 14 deletions(-)

diff --git a/decode.rkt b/decode.rkt
index a930889..c4cf994 100644
--- a/decode.rkt
+++ b/decode.rkt
@@ -32,7 +32,8 @@
                                  #:symbol-proc [symbol-proc (λ(x)x)]
                                  #:valid-char-proc [valid-char-proc (λ(x)x)]
                                  #:cdata-proc [cdata-proc (λ(x)x)]
-                                 #:exclude-tags [excluded-tags '()])
+                                 #:exclude-tags [excluded-tags '()]
+                                 #:exclude-attrs [excluded-attrs '()])
   ((xexpr/c)  
    (#:txexpr-tag-proc (txexpr-tag? . -> . txexpr-tag?)
                       #:txexpr-attrs-proc (txexpr-attrs? . -> . txexpr-attrs?)
@@ -43,13 +44,14 @@
                       #:symbol-proc (symbol? . -> . xexpr?)
                       #:valid-char-proc (valid-char? . -> . xexpr?)
                       #:cdata-proc (cdata? . -> . xexpr?)
-                      #:exclude-tags symbols?) . ->* . txexpr?)
+                      #:exclude-tags (listof txexpr-tag?)
+                      #:exclude-attrs txexpr-attrs?) . ->* . txexpr?)
   
   
   (let loop ([x txexpr])
     (cond
       [(txexpr? x) (let-values([(tag attrs elements) (txexpr->values x)]) 
-                     (if (member tag excluded-tags)    
+                     (if (or (member tag excluded-tags) (ormap (λ(attr) (member attr excluded-attrs)) attrs)) 
                          x ; because it's excluded
                          ;; we apply processing here rather than do recursive descent on the pieces
                          ;; because if we send them back through loop, certain element types are ambiguous
@@ -78,7 +80,8 @@
                                           #:symbol-proc [symbol-proc (λ(x)x)]
                                           #:valid-char-proc [valid-char-proc (λ(x)x)]
                                           #:cdata-proc [cdata-proc (λ(x)x)]
-                                          #:exclude-tags [excluded-tags '()])
+                                          #:exclude-tags [excluded-tags '()]
+                                          #:exclude-attrs [excluded-attrs '()])
   ((txexpr-elements?)  
    (#:txexpr-tag-proc (txexpr-tag? . -> . txexpr-tag?)
                       #:txexpr-attrs-proc (txexpr-attrs? . -> . txexpr-attrs?)
@@ -89,7 +92,8 @@
                       #:symbol-proc (symbol? . -> . xexpr?)
                       #:valid-char-proc (valid-char? . -> . xexpr?)
                       #:cdata-proc (cdata? . -> . xexpr?)
-                      #:exclude-tags symbols?) . ->* . txexpr-elements?)
+                      #:exclude-tags (listof txexpr-tag?)
+                      #:exclude-attrs txexpr-attrs?) . ->* . txexpr-elements?)
   
   (define temp-tag (gensym "temp-tag"))
   (define decode-result (decode `(temp-tag ,@elements)
@@ -102,7 +106,8 @@
                                 #:symbol-proc symbol-proc
                                 #:valid-char-proc valid-char-proc
                                 #:cdata-proc cdata-proc
-                                #:exclude-tags excluded-tags))
+                                #:exclude-tags excluded-tags
+                                #:exclude-attrs excluded-attrs))
   (get-elements decode-result))
 
 
diff --git a/scribblings/decode.scrbl b/scribblings/decode.scrbl
index 24397ed..684b8a4 100644
--- a/scribblings/decode.scrbl
+++ b/scribblings/decode.scrbl
@@ -34,7 +34,8 @@ Another example is conversion of output into a particular data format. Most Poll
 [#:symbol-proc symbol-proc (symbol? . -> . xexpr?) (λ(sym) sym)]
 [#:valid-char-proc valid-char-proc (valid-char? . -> . xexpr?) (λ(vc) vc)]
 [#:cdata-proc cdata-proc (cdata? . -> . xexpr?) (λ(cdata) cdata)]
-[#:exclude-tags tags-to-exclude (listof symbol?) null]
+[#:exclude-tags tags-to-exclude (listof txexpr-tag?) null]
+[#:exclude-attrs attrs-to-exclude txexpr-attrs? null]
 )
 txexpr?]
 Recursively process a @racket[_tagged-xexpr], usually the one exported from a Pollen source file as @racket[doc]. 
@@ -156,12 +157,12 @@ The @racket[_string-proc], @racket[_symbol-proc], @racket[_valid-char-proc], and
 
 
 
-Finally, the @racket[_tags-to-exclude] argument is a list of tags that will be exempted from decoding. Though you could get the same result by testing the input within the individual decoding functions, that's tedious and potentially slower.
+The @racket[_tags-to-exclude] argument is a list of tags that will be exempted from decoding. Though you could get the same result by testing the input within the individual decoding functions, that's tedious and potentially slower.
 
 @examples[#:eval my-eval
 (define tx '(p "I really think" (em "italics") "should be lowercase."))
-(decode tx #:string-proc (λ(s) (string-upcase s)))
-(decode tx #:string-proc (λ(s) (string-upcase s)) #:exclude-tags '(em))
+(decode tx #:string-proc string-upcase)
+(decode tx #:string-proc string-upcase #:exclude-tags '(em))
 ]
 
 The @racket[_tags-to-exclude] argument is useful if you're decoding source that's destined to become HTML. According to the HTML spec, material within a @racket[<style>] or @racket[<script>] block needs to be preserved literally. In this example, if the CSS and JavaScript blocks are capitalized, they won't work. So exclude @racket['(style script)], and problem solved.
@@ -170,11 +171,17 @@ The @racket[_tags-to-exclude] argument is useful if you're decoding source that'
 (define tx '(body (h1 [[class "Red"]] "Let's visit Planet Telex.") 
 (style [[type "text/css"]] ".Red {color: green;}")
 (script [[type "text/javascript"]] "var area = h * w;")))
-(decode tx #:string-proc (λ(s) (string-upcase s)))
-(decode tx #:string-proc (λ(s) (string-upcase s)) 
-#:exclude-tags '(style script))
+(decode tx #:string-proc string-upcase)
+(decode tx #:string-proc string-upcase #:exclude-tags '(style script))
 ]
 
+Finally, the @racket[_attrs-to-exclude] argument works the same way as @racket[_tags-to-exclude], but instead of excluding an element based on its tag, it excludes based on whether the element has a matching attribute/value pair.
+
+@examples[#:eval my-eval
+(define tx '(p (span "No attrs") (span ((id "foo")) "One attr")))
+(decode tx #:string-proc string-upcase)
+(decode tx #:string-proc string-upcase #:exclude-attrs '((id "foo")))
+]
 
 @defproc[
 (decode-elements
@@ -188,7 +195,8 @@ The @racket[_tags-to-exclude] argument is useful if you're decoding source that'
 [#:symbol-proc symbol-proc (symbol? . -> . xexpr?) (λ(sym) sym)]
 [#:valid-char-proc valid-char-proc (valid-char? . -> . xexpr?) (λ(vc) vc)]
 [#:cdata-proc cdata-proc (cdata? . -> . xexpr?) (λ(cdata) cdata)]
-[#:exclude-tags tags-to-exclude (listof symbol?) null]
+[#:exclude-tags tags-to-exclude (listof txexpr-tag?) null]
+[#:exclude-attrs attrs-to-exclude txexpr-attrs? null]
 )
 txexpr-elements?]
 Identical to @racket[decode], but takes @racket[txexpr-elements?] as input rather than a whole tagged X-expression, and likewise returns @racket[txexpr-elements?] rather than a tagged X-expression. A convenience variant for use inside tag functions.