first versioned release

dev-fixit v0.1
Matthew Butterick 9 years ago
parent 50e71ec8c5
commit 7b3d3abee6

@ -1,4 +1,5 @@
#lang info #lang info
(define version "0.1")
(define collection "txexpr") (define collection "txexpr")
(define deps '("base" "sugar" "rackunit-lib")) (define deps '("base" "sugar" "rackunit-lib"))
(define update-implies '("sugar")) (define update-implies '("sugar"))

@ -209,25 +209,24 @@
(can-be-txexpr-attr-value? . -> . txexpr-attr-value?) (can-be-txexpr-attr-value? . -> . txexpr-attr-value?)
(->string x)) (->string x))
(define identity (λ (x) x))
(define+provide+safe (attrs->hash . items-in) (define+provide+safe (attrs->hash #:hash-style? [hash-style-priority #f] . items-in)
(() #:rest (listof can-be-txexpr-attrs?) . ->* . hash-eq?) (() (#:hash-style? boolean?) #:rest (listof can-be-txexpr-attrs?) . ->* . hash-eq?)
;; can be liberal with input because they're all just nested key/value pairs ;; can be liberal with input because they're all just nested key/value pairs
;; but still need this function to make sure that 'foo and "foo" are treated as the same hash key ;; but still need this function to make sure that 'foo and "foo" are treated as the same hash key
(define items (reverse (define items (flatten items-in))
(for/fold ([items null]) ([i (in-list items-in)]) (unless (even? (length items))
(cond (raise-argument-error 'attrs->hash "even number of arguments" items-in))
[(txexpr-attr? i) (append (reverse i) items)] ;; hasheq loop will overwrite earlier values with later.
[(txexpr-attrs? i) (append (append* (map (λ(a) (reverse a)) i)) items)] ;; but earlier attributes need priority (see https://www.w3.org/TR/xml/#attdecls)
[else (cons i items)])))) ;; thus reverse the pairs.
(define (make-key-value-list items) ;; priority-inverted will defeat this assumption, and allow later attributes to overwrite earlier.
(if (< (length items) 2) (for/hasheq ([sublist (in-list ((if hash-style-priority
null identity
(let ([key (->txexpr-attr-key (car items))] reverse) (slice-at items 2)))])
[value (->txexpr-attr-value (cadr items))] (let ([key (->txexpr-attr-key (first sublist))]
[rest (cddr items)]) [value (->txexpr-attr-value (second sublist))])
(cons (cons key value) (make-key-value-list rest))))) (values key value))))
(make-immutable-hasheq (make-key-value-list items)))
(define+provide+safe (hash->attrs attr-hash) (define+provide+safe (hash->attrs attr-hash)
@ -243,13 +242,22 @@
(define+provide+safe (attr-set tx key value) (define+provide+safe (attr-set tx key value)
(txexpr? can-be-txexpr-attr-key? can-be-txexpr-attr-value? . -> . txexpr?) (txexpr? can-be-txexpr-attr-key? can-be-txexpr-attr-value? . -> . txexpr?)
(attr-set* tx key value))
(define+provide+safe (attr-set* tx . kvs)
((txexpr?) #:rest (listof (or/c can-be-txexpr-attr-key? can-be-txexpr-attr-value?)) . ->* . txexpr?)
;; unlike others, this uses hash operations to guarantee that your attr-set ;; unlike others, this uses hash operations to guarantee that your attr-set
;; is the only one remaining. ;; is the only one remaining.
(unless (even? (length kvs))
(raise-argument-error 'attr-set* "even number of arguments" kvs))
(define new-attrs (define new-attrs
(hash->attrs (hash-set (attrs->hash (get-attrs tx)) (hash->attrs
(->txexpr-attr-key key) (apply hash-set* (attrs->hash (get-attrs tx))
(->txexpr-attr-value value)))) (append-map (λ(sublist)
(make-txexpr (get-tag tx) new-attrs (get-elements tx))) (list (->txexpr-attr-key (first sublist))
(->txexpr-attr-value (second sublist)))) (slice-at kvs 2)))))
(txexpr (get-tag tx) new-attrs (get-elements tx)))
(define+provide+safe (attr-join tx key value) (define+provide+safe (attr-join tx key value)
@ -260,35 +268,16 @@
(attr-set tx key (string-join `(,@starting-values ,value) " "))) (attr-set tx key (string-join `(,@starting-values ,value) " ")))
(define+provide+safe (attr-set* tx . kvs)
((txexpr?) #:rest (listof (or/c can-be-txexpr-attr-key? can-be-txexpr-attr-value?)) . ->* . txexpr?)
(foldl (λ(kv acc-tx) (attr-set acc-tx (first kv) (second kv))) tx (slice-at kvs 2)))
(define+provide+safe (attr-ref tx key) (define+provide+safe (attr-ref tx key [failure-result (λ _ (raise (make-exn:fail:contract (format "attr-ref: no value found for key ~v" key) (current-continuation-marks))))])
(txexpr? can-be-txexpr-attr-key? . -> . txexpr-attr-value?) ((txexpr? can-be-txexpr-attr-key?) (any/c) . ->* . any)
(define result (assq (->txexpr-attr-key key) (get-attrs tx))) (define result (assq (->txexpr-attr-key key) (get-attrs tx)))
(unless result (if result
(error (format "attr-ref: no value found for key ~v" key))) (second result)
(second result)) (if (procedure? failure-result)
(failure-result)
failure-result)))
(define+provide+safe (attr-ref* tx key)
(txexpr? can-be-txexpr-attr-key? . -> . txexpr-attr-values?)
(define results empty)
(let loop ([tx tx])
(when (and (txexpr? tx) (attrs-have-key? tx key) (attr-ref tx key))
(set! results (cons (attr-ref tx key) results))
(map loop (get-elements tx))
(void)))
(reverse results))
;; convert list of alternating keys & values to attr
;; with override behavior (using hash)
(define+provide+safe (merge-attrs . items)
(() #:rest list-of-can-be-txexpr-attrs? . ->* . txexpr-attrs?)
(hash->attrs (apply attrs->hash items)))
(define+provide+safe (remove-attrs x) (define+provide+safe (remove-attrs x)
@ -296,19 +285,19 @@
(let loop ([x x]) (let loop ([x x])
(if (txexpr? x) (if (txexpr? x)
(let-values ([(tag attr elements) (txexpr->values x)]) (let-values ([(tag attr elements) (txexpr->values x)])
(make-txexpr tag null (map loop elements))) (txexpr tag null (map loop elements)))
x))) x)))
(define+provide+safe (map-elements/exclude proc x exclude-test) (define (map-elements/exclude proc x exclude-test)
(procedure? txexpr? procedure? . -> . txexpr?) (procedure? txexpr? procedure? . -> . txexpr?)
(cond (cond
[(txexpr? x) [(txexpr? x)
(if (exclude-test x) (if (exclude-test x)
x x
(let-values ([(tag attr elements) (txexpr->values x)]) (let-values ([(tag attr elements) (txexpr->values x)])
(make-txexpr tag attr (txexpr tag attr
(map (λ(x)(map-elements/exclude proc x exclude-test)) elements))))] (map (λ(x)(map-elements/exclude proc x exclude-test)) elements))))]
;; externally the function only accepts txexpr, ;; externally the function only accepts txexpr,
;; but internally we don't care ;; but internally we don't care
[else (proc x)])) [else (proc x)]))
@ -330,8 +319,8 @@
(set! matches (cons x matches)) (set! matches (cons x matches))
(proc x))] (proc x))]
[(txexpr? x) (let-values([(tag attr elements) (txexpr->values x)]) [(txexpr? x) (let-values([(tag attr elements) (txexpr->values x)])
(make-txexpr tag attr (filter (λ(e) (not (equal? e deleted-signal))) (txexpr tag attr (filter (λ(e) (not (equal? e deleted-signal)))
(map do-extraction elements))))] (map do-extraction elements))))]
[else x])) [else x]))
(define tx-extracted (do-extraction tx)) ;; do this first to fill matches (define tx-extracted (do-extraction tx)) ;; do this first to fill matches
(unless (txexpr? tx-extracted) (unless (txexpr? tx-extracted)
@ -362,10 +351,10 @@
(xexpr->string (let loop ([x x]) (xexpr->string (let loop ([x x])
(cond (cond
[(txexpr? x) (if (member (get-tag x) '(script style)) [(txexpr? x) (if (member (get-tag x) '(script style))
(make-txexpr (get-tag x) (get-attrs x) (txexpr (get-tag x) (get-attrs x)
(map ->cdata (get-elements x))) (map ->cdata (get-elements x)))
(make-txexpr (get-tag x) (get-attrs x) (txexpr (get-tag x) (get-attrs x)
(map loop (get-elements x))))] (map loop (get-elements x))))]
[else x])))) [else x]))))
@ -382,7 +371,7 @@
[sort-attrs (λ(x) [sort-attrs (λ(x)
(if (txexpr? x) (if (txexpr? x)
(let-values ([(tag attr elements) (txexpr->values x)]) (let-values ([(tag attr elements) (txexpr->values x)])
(make-txexpr tag (sort attr #:key stringify-attr #:cache-keys? #t string<?) (map sort-attrs elements))) (txexpr tag (sort attr #:key stringify-attr #:cache-keys? #t string<?) (map sort-attrs elements)))
x))]) x))])
(equal? (sort-attrs tx1) (sort-attrs tx2)))) (equal? (sort-attrs tx1) (sort-attrs tx2))))

@ -50,35 +50,33 @@ It's an X-expression with the following grammar:
[element xexpr?] [element xexpr?]
] ]
A txexpr is a list with a symbol in the first position — the @italic{tag} — followed by a series of @italic{elements}, which are other X-expressions. Optionally, a txexpr can have a list of @italic{attributes} in the second position. A tagged X-expression — @italic{txexpr} for short — is a list with a symbol in the first position — the @italic{tag} — followed by a series of @italic{elements}, which are other X-expressions. Optionally, a txexpr can have a list of @italic{attributes} in the second position.
@examples[#:eval my-eval @examples[#:eval my-eval
(txexpr? '(span "Brennan" "Dale")) (txexpr? '(span "Brennan" "Dale"))
(txexpr? '(span "Brennan" (em "Richard") "Dale")) (txexpr? '(span "Brennan" (em "Richard") "Dale"))
(txexpr? '(span [[class "hidden"][id "names"]] "Brennan" "Dale")) (txexpr? '(span ((class "hidden")(id "names")) "Brennan" "Dale"))
(txexpr? '(span lt gt amp)) (txexpr? '(span lt gt amp))
(txexpr? '("We really" "should have" "a tag")) (txexpr? '("We really" "should have" "a tag"))
(txexpr? '(span [[class not-quoted]] "Brennan")) (txexpr? '(span ((class not-quoted)) "Brennan"))
(txexpr? '(span [class "hidden"] "Brennan" "Dale")) (txexpr? '(span (class "hidden") "Brennan" "Dale"))
] ]
The last one is a common mistake. Because the keyvalue pair is not enclosed in a @racket[list], it's interpreted as a nested txexpr within the first txexpr, as you may not find out until you try to read its attributes: The last one is a common mistake. Because the keyvalue pair is not enclosed in a @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{list}, it's interpreted as a nested txexpr within the first txexpr, as you may not find out until you try to read its attributes:
@margin-note{There's no way of eliminating this ambiguity, short of always requiring an attribute list — empty if necessary — in your txexpr. See also @racket[xexpr-drop-empty-attributes].}
@examples[#:eval my-eval @examples[#:eval my-eval
(get-attrs '(span [class "hidden"] "Brennan" "Dale")) (get-attrs '(span (class "hidden") "Brennan" "Dale"))
(get-elements '(span [class "hidden"] "Brennan" "Dale")) (get-elements '(span (class "hidden") "Brennan" "Dale"))
] ]
Tagged X-expressions are most commonly found in HTML & XML documents. Though the notation is different in Racket, the data structure is identical: Tagged X-expressions are most commonly found in HTML & XML documents. Though the notation is different in Racket, the data structure is identical:
@examples[#:eval my-eval @examples[#:eval my-eval
(xexpr->string '(span [[id "names"]] "Brennan" (em "Richard") "Dale")) (xexpr->string '(span ((id "names")) "Brennan" (em "Richard") "Dale"))
(string->xexpr "<span id=\"names\">Brennan<em>Richard</em>Dale</span>") (string->xexpr "<span id=\"names\">Brennan<em>Richard</em>Dale</span>")
] ]
After converting to and from HTML, we get back the original X-expression. Well, almost. The brackets turned into parentheses — no big deal, since they mean the same thing in Racket. Also, per its usual practice, @racket[string->xexpr] added an empty attribute list after @racket[em]. This is also benign. After converting to and from HTML, we get back the original X-expression. Well, almost. Per its usual practice, @racket[string->xexpr] added an empty attribute list after @racket[em]. This is benign — an empty attribute list can be omitted with no change in meaning, or vice versa.
@section{Why not just use @exec{match}, @exec{quasiquote}, and so on?} @section{Why not just use @exec{match}, @exec{quasiquote}, and so on?}
@ -90,7 +88,8 @@ If you prefer those, please do. But I've found two benefits to using module func
The programming is trivial, but the annoyance is real. The programming is trivial, but the annoyance is real.
@section{Interface} @section{Predicates}
@deftogether[( @deftogether[(
@defproc[ @defproc[
@ -154,24 +153,7 @@ boolean?]
[v any/c]) [v any/c])
boolean?] boolean?]
)] )]
Shorthand for @code{(listof txexpr-tag?)}, @code{(listof txexpr-attr?)}, and @code{(listof txexpr-element?)}. Predicates equivalent to a list of @code{txexpr-tag?}, @code{txexpr-attr?}, or @code{txexpr-element?}, respectively.
@defproc[
(validate-txexpr
[possible-txexpr any/c])
txexpr?]
Like @racket[txexpr?], but raises a descriptive error if @racket[_possible-txexpr] is invalid, and otherwise returns @racket[_possible-txexpr] itself.
@examples[#:eval my-eval
(validate-txexpr 'root)
(validate-txexpr '(root))
(validate-txexpr '(root ((id "top")(class 42))))
(validate-txexpr '(root ((id "top")(class "42"))))
(validate-txexpr '(root ((id "top")(class "42")) ("hi")))
(validate-txexpr '(root ((id "top")(class "42")) "hi"))
]
@ -186,63 +168,64 @@ boolean?]
(can-be-txexpr-attr-value? (can-be-txexpr-attr-value?
[v any/c]) [v any/c])
boolean?] boolean?]
)] )]
Predicates for input arguments that are trivially converted to an attribute @racket[_key] or @racket[_value]… Predicates for input arguments that can be trivially converted to an attribute @racket[_key] or @racket[_value] with the associated conversion functions.
@examples[#:eval my-eval
(can-be-txexpr-attr-key? 'symbol)
(can-be-txexpr-attr-key? "string-val")
(can-be-txexpr-attr-key? (list 1 2 3))
(can-be-txexpr-attr-value? 'symbol)
(can-be-txexpr-attr-value? "string-val")
(can-be-txexpr-attr-value? (list 1 2 3))
]
@deftogether[(
@defproc[
(->txexpr-attr-key
[v can-be-txexpr-attr-key?])
txexpr-attr-key?]
@defproc[ @defproc[
(->txexpr-attr-value (can-be-txexpr-attrs?
[v can-be-txexpr-attr-value?]) [v any/c])
txexpr-attr-value?] boolean?]
)] Predicate for functions that handle @racket[_txexpr-attrs]. Covers values that are easily converted into pairs of @racket[_attr-key] and @racket[_attr-value]. Namely: single @racket[_xexpr-attr]s, lists of @racket[_xexpr-attr]s (i.e., what you get from @racket[get-attrs]), or interleaved symbols and strings (each pair will be concatenated into a single @racket[_xexpr-attr]).
 with these conversion functions.
@defproc[ @defproc[
(txexpr->values (validate-txexpr
[tx txexpr?]) [possible-txexpr any/c])
(values txexpr-tag? txexpr-attrs? txexpr-elements?)] txexpr?]
Dissolves a @racket[_txexpr] into its components and returns all three. Like @racket[txexpr?], but raise a descriptive error if @racket[_possible-txexpr] is invalid, and otherwise return @racket[_possible-txexpr] itself.
@examples[#:eval my-eval @examples[#:eval my-eval
(txexpr->values '(div)) (validate-txexpr 'root)
(txexpr->values '(div "Hello" (p "World"))) (validate-txexpr '(root))
(txexpr->values '(div [[id "top"]] "Hello" (p "World"))) (validate-txexpr '(root ((id "top")(class 42))))
(validate-txexpr '(root ((id "top")(class "42"))))
(validate-txexpr '(root ((id "top")(class "42")) ("hi")))
(validate-txexpr '(root ((id "top")(class "42")) "hi"))
] ]
@defproc[
(txexpr->list
[tx txexpr?])
(list txexpr-tag?
txexpr-attrs?
txexpr-elements?)]
Like @racket[txexpr->values], but returns the three components in a list.
@examples[#:eval my-eval
(txexpr->list '(div))
(txexpr->list '(div "Hello" (p "World"))) @section{Making & breaking}
(txexpr->list '(div [[id "top"]] "Hello" (p "World")))
]
@defproc[ @defproc[
(xexpr->html (txexpr
[x xexpr?]) [tag txexpr-tag?]
string?] [attrs txexpr-attrs? @empty]
Convert @racket[_x] to an HTML string. Better than @racket[xexpr->string] because consistent with the HTML spec, it will not escape text that appears within @code{script} or @code{style} blocks. For convenience, this function will take any X-expression, not just tagged X-expressions. [elements txexpr-elements? @empty])
txexpr?]
Assemble a @racket[_txexpr] from its parts. If you don't have attributes, but you do have elements, you'll need to pass @racket[empty] (or @racket[null] or @racket['()]) as the second argument. Note that unlike @racket[xml->xexpr], if the attribute list is empty, it's not included in the resulting expression.
@examples[#:eval my-eval @examples[#:eval my-eval
(define tx '(root (script "3 > 2") "Why is 3 > 2?")) (txexpr 'div)
(xexpr->string tx) (txexpr 'div '() '("Hello" (p "World")))
(xexpr->html tx) (txexpr 'div '((id "top")))
(map xexpr->html (list "string" 'entity 65)) (txexpr 'div '((id "top")) '("Hello" (p "World")))
(define tx '(div ((id "top")) "Hello" (p "World")))
(txexpr (get-tag tx)
(get-attrs tx) (get-elements tx))
] ]
@ -265,47 +248,44 @@ txexpr-attr?]
Accessor functions for the individual pieces of a @racket[_txexpr]. Accessor functions for the individual pieces of a @racket[_txexpr].
@examples[#:eval my-eval @examples[#:eval my-eval
(get-tag '(div [[id "top"]] "Hello" (p "World"))) (get-tag '(div ((id "top")) "Hello" (p "World")))
(get-attrs '(div [[id "top"]] "Hello" (p "World"))) (get-attrs '(div ((id "top")) "Hello" (p "World")))
(get-elements '(div [[id "top"]] "Hello" (p "World"))) (get-elements '(div ((id "top")) "Hello" (p "World")))
] ]
@defproc[
(txexpr
[tag txexpr-tag?]
[attrs txexpr-attrs? @empty]
[elements txexpr-elements? @empty])
txexpr?]
Assemble a @racket[_txexpr] from its parts. If you don't have attributes, but you do have elements, you'll need to pass @racket[empty] as the second argument. Note that unlike @racket[xml->xexpr], if the attribute list is empty, it's not included in the resulting expression.
@examples[#:eval my-eval @deftogether[(
(txexpr 'div)
(txexpr 'div '() '("Hello" (p "World")))
(txexpr 'div '[[id "top"]])
(txexpr 'div '[[id "top"]] '("Hello" (p "World")))
(define tx '(div [[id "top"]] "Hello" (p "World")))
(txexpr (get-tag tx)
(get-attrs tx) (get-elements tx))
]
@defproc[ @defproc[
(make-txexpr (txexpr->values
[tag txexpr-tag?] [tx txexpr?])
[attrs txexpr-attrs? @empty] (values txexpr-tag? txexpr-attrs? txexpr-elements?)]
[elements txexpr-elements? @empty])
txexpr?]
Alternate name for @racket[txexpr].
@defproc[ @defproc[
(can-be-txexpr-attrs? (txexpr->list
[v any/c]) [tx txexpr?])
boolean?] (list txexpr-tag?
Predicate for functions that handle @racket[_txexpr-attrs]. Covers values that are easily converted into pairs of @racket[_attr-key] and @racket[_attr-value]. Namely: single @racket[_xexpr-attr]s, lists of @racket[_xexpr-attr]s (i.e., what you get from @racket[get-attrs]), or interleaved symbols and strings (each pair will be concatenated into a single @racket[_xexpr-attr]). txexpr-attrs?
txexpr-elements?)]
)]
Dissolve a @racket[_txexpr] into its components. @racket[txexpr->values] returns the components as multiple values; @racket[txexpr->list] returns them in a list.
@examples[#:eval my-eval
(txexpr->values '(div))
(txexpr->values '(div "Hello" (p "World")))
(txexpr->values '(div ((id "top")) "Hello" (p "World")))
(txexpr->list '(div))
(txexpr->list '(div "Hello" (p "World")))
(txexpr->list '(div ((id "top")) "Hello" (p "World")))
]
@section{Attributes}
@deftogether[( @deftogether[(
@defproc[ @defproc[
(attrs->hash [x can-be-txexpr-attrs?] ...) (attrs->hash
[#:hash-style? hash-style-priority boolean? #f]
[x can-be-txexpr-attrs?] ...)
hash-eq?] hash-eq?]
@defproc[ @defproc[
@ -314,12 +294,14 @@ hash-eq?]
txexpr-attrs?] txexpr-attrs?]
)] )]
Convert @racket[_attrs] to an immutable hash, and back again. Convert @racket[_attrs] to an immutable hash, and back again. Following the convention specified for @link["https://www.w3.org/TR/xml/#attdecls"]{XML parsers}, the @italic{first} appearance of an attribute name binds the value — later attributes with the same name are ignored. If you prefer the typical @racket[hash] behavior where later values override earlier ones, set @racket[#:hash-style?] to @racket[#t].
@examples[#:eval my-eval @examples[#:eval my-eval
(define tx '(div [[id "top"][class "red"]] "Hello" (p "World"))) (define tx '(div ((id "top")(class "red")) "Hello" (p "World")))
(attrs->hash (get-attrs tx)) (attrs->hash (get-attrs tx))
(hash->attrs '#hasheq((class . "red") (id . "top"))) (hash->attrs '#hasheq((class . "red") (id . "top")))
(attrs->hash '((color "blue")(color "green")))
(attrs->hash #:hash-style? #t '((color "blue")(color "green")))
] ]
@defproc[ @defproc[
@ -327,10 +309,10 @@ Convert @racket[_attrs] to an immutable hash, and back again.
[attrs (or/c txexpr-attrs? txexpr?)] [attrs (or/c txexpr-attrs? txexpr?)]
[key can-be-txexpr-attr-key?]) [key can-be-txexpr-attr-key?])
boolean?] boolean?]
Returns @racket[#t] if the @racket[_attrs] contain a value for the given @racket[_key], @racket[#f] otherwise. Return @racket[#t] if the @racket[_attrs] contain a value for the given @racket[_key], @racket[#f] otherwise.
@examples[#:eval my-eval @examples[#:eval my-eval
(define tx '(div [[id "top"][class "red"]] "Hello" (p "World"))) (define tx '(div ((id "top")(class "red")) "Hello" (p "World")))
(attrs-have-key? tx 'id) (attrs-have-key? tx 'id)
(attrs-have-key? tx 'grackle) (attrs-have-key? tx 'grackle)
] ]
@ -340,42 +322,36 @@ Returns @racket[#t] if the @racket[_attrs] contain a value for the given @racket
[attrs (or/c txexpr-attrs? txexpr?)] [attrs (or/c txexpr-attrs? txexpr?)]
[other-attrs (or/c txexpr-attrs? txexpr?)]) [other-attrs (or/c txexpr-attrs? txexpr?)])
boolean?] boolean?]
Returns @racket[#t] if @racket[_attrs] and @racket[_other-attrs] contain the same keys and values, @racket[#f] otherwise. The order of attributes is irrelevant. Return @racket[#t] if @racket[_attrs] and @racket[_other-attrs] contain the same keys and values, @racket[#f] otherwise. The order of attributes is irrelevant. (If order matters to you, use good old @racket[equal?] instead.)
@examples[#:eval my-eval @examples[#:eval my-eval
(define tx1 '(div [[id "top"][class "red"]] "Hello")) (define tx1 '(div ((id "top")(class "red")) "Hello"))
(define tx2 '(p [[class "red"][id "top"]] "Hello")) (define tx2 '(p ((class "red")(id "top")) "Hello"))
(define tx3 '(p [[id "bottom"][class "red"]] "Hello")) (define tx3 '(p ((id "bottom")(class "red")) "Hello"))
(attrs-equal? tx1 tx2) (attrs-equal? tx1 tx2)
(attrs-equal? tx1 tx3) (attrs-equal? tx1 tx3)
(equal? tx1 tx2)
(equal? tx1 tx3)
] ]
@defproc[ @defproc[
(attr-ref (attr-ref
[tx txexpr?] [tx txexpr?]
[key can-be-txexpr-attr-key?]) [key can-be-txexpr-attr-key?]
can-be-txexpr-attr-value?] [failure-result any/c (λ _ (raise (make-exn:fail:contract ....)))
Given a @racket[_key], look up the corresponding @racket[_value] in the attributes of a @racket[_txexpr]. Asking for a nonexistent key produces an error. ])
any]
Given a @racket[_key], return the corresponding @racket[_value] from the attributes of a @racket[_txexpr]. By default, asking for a nonexistent key produces an error. But if a value or procedure is provided as the @racket[_failure-result], evaluate and return that instead.
@examples[#:eval my-eval @examples[#:eval my-eval
(attr-ref tx 'class) (attr-ref tx 'class)
(attr-ref tx 'id) (attr-ref tx 'id)
(attr-ref tx 'nonexistent-key) (attr-ref tx 'nonexistent-key)
(attr-ref tx 'nonexistent-key "forty-two")
(attr-ref tx 'nonexistent-key (λ _ (* 6 7)))
] ]
@defproc[ @deftogether[(
(attr-ref*
[tx txexpr?]
[key can-be-txexpr-attr-key?])
(listof can-be-txexpr-attr-value?)]
Like @racket[attr-ref], but returns a recursively gathered list of all the @racket[_value]s for that key within @racket[_tx]. Asking for a nonexistent key produces @racket[null].
@examples[#:eval my-eval
(define tx '(div [[class "red"]] "Hello" (em ([class "blue"]) "world")))
(attr-ref* tx 'class)
(attr-ref* tx 'nonexistent-key)
]
@defproc[ @defproc[
(attr-set (attr-set
@ -383,14 +359,7 @@ Like @racket[attr-ref], but returns a recursively gathered list of all the @rack
[key can-be-txexpr-attr-key?] [key can-be-txexpr-attr-key?]
[value can-be-txexpr-attr-value?]) [value can-be-txexpr-attr-value?])
txexpr?] txexpr?]
Given a @racket[_txexpr], set the value of attribute @racket[_key] to @racket[_value]. Return the updated @racket[_txexpr].
@examples[#:eval my-eval
(define tx '(div [[class "red"][id "top"]] "Hello" (p "World")))
(attr-set tx 'id "bottom")
(attr-set tx 'class "blue")
(attr-set (attr-set tx 'id "bottom") 'class "blue")
]
@defproc[ @defproc[
(attr-set* (attr-set*
@ -398,67 +367,54 @@ Given a @racket[_txexpr], set the value of attribute @racket[_key] to @racket[_v
[key can-be-txexpr-attr-key?] [key can-be-txexpr-attr-key?]
[value can-be-txexpr-attr-value?] ... ... ) [value can-be-txexpr-attr-value?] ... ... )
txexpr?] txexpr?]
Like @racket[attr-set], but accepts any number of keys and values. )]
Set the value of attribute @racket[_key] to @racket[_value] in @racket[_txexpr]. Return the updated @racket[_txexpr]. Duplicate attributes, if they exist, are resolved using @racket[attr->hash]. @racket[attr-set] only accepts one key and one value; @racket[attr-set*] accepts any number.
@examples[#:eval my-eval @examples[#:eval my-eval
(define tx '(div ((class "red")(id "top")) "Hello" (p "World")))
(attr-set tx 'id "bottom")
(attr-set tx 'class "blue")
(attr-set (attr-set tx 'id "bottom") 'class "blue")
(define tx '(div "Hello")) (define tx '(div "Hello"))
(attr-set* tx 'id "bottom" 'class "blue") (attr-set* tx 'id "bottom" 'class "blue")
] ]
@defproc[ @defproc[
(attr-join (attr-join
[tx txexpr?] [tx txexpr?]
[key can-be-txexpr-attr-key?] [key can-be-txexpr-attr-key?]
[value can-be-txexpr-attr-value?]) [value can-be-txexpr-attr-value?])
txexpr?] txexpr?]
Given a @racket[_txexpr], append the value of attribute @racket[_key] with @racket[_value]. Return the updated @racket[_txexpr]. Given a @racket[_txexpr], append attribute @racket[_key] with @racket[_value]. Return the updated @racket[_txexpr]. If @racket[_key] doesn't already exist, then add a new attribute (i.e., behave like @racket[attr-set]).
@examples[#:eval my-eval @examples[#:eval my-eval
(define tx '(div [[class "red"]] "Hello")) (define tx '(div ((class "red")) "Hello"))
(attr-join tx 'class "small") (attr-join tx 'class "small")
(attr-join tx 'klass "small")
] ]
@defproc[
(merge-attrs
[attrs (listof can-be-txexpr-attrs?)] ...)
txexpr-attrs?]
Combine a series of attributes into a single @racket[_txexpr-attrs] item. This function addresses three annoyances that surface in working with txexpr attributes.
@itemlist[#:style 'ordered
@item{You can pass the attributes in multiple forms. See @racket[can-be-txexpr-attrs?] for further details.}
@item{Attributes with the same name are merged, with the later value taking precedence (i.e., @racket[hash] behavior). }
@item{Attributes are sorted in alphabetical order.}]
@examples[#:eval my-eval
(define tx '(div [[id "top"][class "red"]] "Hello" (p "World")))
(define tx-attrs (get-attrs tx))
tx-attrs
(merge-attrs tx-attrs 'editable "true")
(merge-attrs tx-attrs 'id "override-value")
(define my-attr '(id "another-override"))
(merge-attrs tx-attrs my-attr)
(merge-attrs my-attr tx-attrs)
]
@defproc[ @defproc[
(remove-attrs (remove-attrs
[tx txexpr?]) [tx txexpr?])
txexpr?] txexpr?]
Recursively remove all attributes. Recursively remove all attributes from @racket[_tx].
@examples[#:eval my-eval @examples[#:eval my-eval
(define tx '(div [[id "top"]] "Hello" (p [[id "lower"]] "World"))) (define tx '(div ((id "top")) "Hello" (p ((id "lower")) "World")))
(remove-attrs tx) (remove-attrs tx)
] ]
@section{Strange magic}
@defproc[ @defproc[
(map-elements (map-elements
[proc procedure?] [proc procedure?]
[tx txexpr?]) [tx txexpr?])
txexpr?] txexpr?]
Recursively apply @racket[_proc] to all elements, leaving tags and attributes alone. Using plain @racket[map] will only process elements at the top level of the current @racket[_txexpr]. Usually that's not what you want. Recursively apply @racket[_proc] to all elements, leaving tags and attributes alone. Using plain @racket[map] will only process elements at the top level of @racket[_tx]. Usually that's not what you want.
@examples[#:eval my-eval @examples[#:eval my-eval
(define tx '(div "Hello!" (p "Welcome to" (strong "Mars")))) (define tx '(div "Hello!" (p "Welcome to" (strong "Mars"))))
@ -467,7 +423,7 @@ Recursively apply @racket[_proc] to all elements, leaving tags and attributes al
(map-elements upcaser tx) (map-elements upcaser tx)
] ]
In practice, most @racket[_xexpr-element]s are strings. But woe befalls those who pass string procedures to @racket[map-elements], because an @racket[_xexpr-element] can be any kind of @racket[xexpr?], and an @racket[xexpr?] is not necessarily a string. In practice, most @racket[_txexpr-element]s are strings. But it's unwise to pass string-only procedures to @racket[map-elements], because an @racket[_txexpr-element] can be any kind of @racket[xexpr?], and an @racket[xexpr?] is not necessarily a string.
@examples[#:eval my-eval @examples[#:eval my-eval
(define tx '(p "Welcome to" (strong "Mars" amp "Sons"))) (define tx '(p "Welcome to" (strong "Mars" amp "Sons")))
@ -476,30 +432,6 @@ In practice, most @racket[_xexpr-element]s are strings. But woe befalls those wh
(map-elements upcaser tx) (map-elements upcaser tx)
] ]
@defproc[
(map-elements/exclude
[proc procedure?]
[tx txexpr?]
[exclude-test (txexpr? . -> . boolean?)])
txexpr?]
Like @racket[map-elements], but skips any @racket[_txexprs] that evaluate to @racket[#t] under @racket[_exclude-test]. The @racket[_exclude-test] gets a whole txexpr as input, so it can test any of its parts.
@examples[#:eval my-eval
(define tx '(div "Hello!" (p "Welcome to" (strong "Mars"))))
(define upcaser (λ(x) (if (string? x) (string-upcase x) x)))
(map-elements upcaser tx)
(map-elements/exclude upcaser tx (λ(x) (equal? (get-tag x) 'strong)))
]
Be careful with the wider consequences of exclusion tests. When @racket[_exclude-test] is true, the @racket[_txexpr] is excluded, but so is everything underneath that @racket[_txexpr]. In other words, there is no way to re-include (un-exclude?) elements nested under an excluded element.
@examples[#:eval my-eval
(define tx '(div "Hello!" (p "Welcome to" (strong "Mars"))))
(define upcaser (λ(x) (if (string? x) (string-upcase x) x)))
(map-elements upcaser tx)
(map-elements/exclude upcaser tx (λ(x) (equal? (get-tag x) 'p)))
(map-elements/exclude upcaser tx (λ(x) (equal? (get-tag x) 'div)))
]
@defproc[ @defproc[
(splitf-txexpr (splitf-txexpr
@ -526,17 +458,19 @@ Ordinarily, the result of the split operation is to remove the elements that mat
@deftogether[( @deftogether[(
@defproc[ @defproc[
(findf*-txexpr (findf-txexpr
[tx txexpr?] [tx txexpr?]
[pred procedure?]) [pred procedure?])
(or/c #f (listof txexpr-element?))] (or/c #f txexpr-element?)]
@defproc[ @defproc[
(findf-txexpr (findf*-txexpr
[tx txexpr?] [tx txexpr?]
[pred procedure?]) [pred procedure?])
(or/c #f txexpr-element?)] (or/c #f (listof 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]. 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].
@ -552,6 +486,25 @@ Like @racket[splitf-txexpr], but only retrieve the elements that match @racket[_
] ]
@section{HTML conversion}
@defproc[
(xexpr->html
[x xexpr?])
string?]
Convert @racket[_x] to an HTML string. Better than @racket[xexpr->string] because consistent with the HTML spec, it will skip the content of @code{script} or @code{style} blocks. For convenience, this function will take any X-expression, not just tagged X-expressions.
@examples[#:eval my-eval
(define tx '(root (script "3 > 2") "Why is 3 > 2?"))
(xexpr->string tx)
(xexpr->html tx)
(map xexpr->html (list "string" 'entity 65))
]
@section{Unit testing}
@defproc[ @defproc[
(check-txexprs-equal? (check-txexprs-equal?
[tx1 txexpr?] [tx1 txexpr?]

@ -121,13 +121,19 @@
(check-equal? (->txexpr-attr-value 'foo) "foo") (check-equal? (->txexpr-attr-value 'foo) "foo")
(check-equal? (attrs->hash '((foo "bar"))) '#hasheq((foo . "bar"))) (check-equal? (attrs->hash '((foo "bar"))) '#hasheq((foo . "bar")))
(check-equal? (attrs->hash '((foo "bar")) '(foo "fraw")) '#hasheq((foo . "fraw"))) (check-equal? (attrs->hash '((foo "bar") (foo "fraw"))) '#hasheq((foo . "bar")))
(check-equal? (attrs->hash '((foo "bar")) '(foo "fraw") 'foo "dog") '#hasheq((foo . "dog"))) (check-equal? (attrs->hash #:hash-style? #t '((foo "bar") (foo "fraw"))) '#hasheq((foo . "fraw")))
(check-equal? (attrs->hash '((foo "bar")) '(foo "fraw")) '#hasheq((foo . "bar")))
(check-equal? (attrs->hash '((foo "bar")) '(foo "fraw") 'foo "dog") '#hasheq((foo . "bar")))
(check-exn exn:fail:contract? (λ _ (attrs->hash 'foo "bar" 'zam)))
(check-equal? (apply set (hash->attrs '#hash((foo . "bar")(hee . "haw")))) (check-equal? (apply set (hash->attrs '#hash((foo . "bar")(hee . "haw"))))
(apply set '((foo "bar")(hee "haw")))) (apply set '((foo "bar")(hee "haw"))))
(check-equal? (attr-ref '(p ((foo "bar"))) 'foo) "bar") (check-equal? (attr-ref '(p ((foo "bar"))) 'foo) "bar")
(check-exn exn:fail? (λ _ (attr-ref '(p ((foo "bar"))) 'zam)))
(check-equal? (attr-ref '(p ((foo "bar"))) 'zam 42) 42)
(check-equal? (attr-ref '(p ((foo "bar"))) 'zam (λ _ (* 6 7))) 42)
(check-txexprs-equal? (attr-set '(p ((foo "bar"))) 'foo "fraw") '(p ((foo "fraw")))) (check-txexprs-equal? (attr-set '(p ((foo "bar"))) 'foo "fraw") '(p ((foo "fraw"))))
(check-txexprs-equal? (attr-set* '(p ((foo "bar"))) 'foo "fraw") '(p ((foo "fraw")))) (check-txexprs-equal? (attr-set* '(p ((foo "bar"))) 'foo "fraw") '(p ((foo "fraw"))))
(check-true (let ([result (attr-set* '(p ((foo "bar"))) 'foo "fraw" 'zim 'zam)]) (check-true (let ([result (attr-set* '(p ((foo "bar"))) 'foo "fraw" 'zim 'zam)])
@ -176,16 +182,6 @@
(check-attrs-equal? '((foo "bar")(foo "zam")) '((foo "zam")(foo "bar"))) (check-attrs-equal? '((foo "bar")(foo "zam")) '((foo "zam")(foo "bar")))
(check-attrs-equal? (merge-attrs 'foo "bar") '((foo "bar")))
(check-attrs-equal? (merge-attrs '(foo "bar")) '((foo "bar")))
(check-attrs-equal? (merge-attrs '((foo "bar"))) '((foo "bar")))
(check-attrs-equal? (merge-attrs "foo" 'bar) '((foo "bar")))
(check-attrs-equal? (merge-attrs "foo" "bar" "goo" "gar") '((foo "bar")(goo "gar")))
(check-attrs-equal? (merge-attrs (merge-attrs "foo" "bar" "goo" "gar") "hee" "haw")
'((foo "bar")(goo "gar")(hee "haw")))
(check-attrs-equal? (merge-attrs '((foo "bar")(goo "gar")) "foo" "haw") '((foo "haw")(goo "gar")))
(check-txexprs-equal? (remove-attrs '(p ((foo "bar")) "hi")) '(p "hi")) (check-txexprs-equal? (remove-attrs '(p ((foo "bar")) "hi")) '(p "hi"))
(check-txexprs-equal? (remove-attrs '(p ((foo "bar")) "hi" (p ((foo "bar")) "hi"))) '(p "hi" (p "hi"))) (check-txexprs-equal? (remove-attrs '(p ((foo "bar")) "hi" (p ((foo "bar")) "hi"))) '(p "hi" (p "hi")))
@ -197,11 +193,7 @@
(check-equal? (attr-set '(p) 'foo "zim") '(p ((foo "zim")))) (check-equal? (attr-set '(p) 'foo "zim") '(p ((foo "zim"))))
(check-equal? (attr-set '(p ((foo "bar")(foo "zam"))) 'foo "zim") '(p ((foo "zim")))) (check-equal? (attr-set '(p ((foo "bar")(foo "zam"))) 'foo "zim") '(p ((foo "zim"))))
(check-equal? (attr-ref* '(root ((foo "bar")) "hello" "world" (meta ((foo "zam")) "bar2") (check-exn exn:fail:contract? (λ _ (attr-set* '(p) 'foo "bar" 'zam)))
(em ((foo "zam")) "goodnight" "moon")) 'foo) '("bar" "zam" "zam"))
(check-equal? (attr-ref* '(root ((foo "bar")) "hello" "world" (meta ((foo "zam")) "bar2")
(em ((foo "zam")) "goodnight" "moon")) 'nonexistent-key) '())
(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")

@ -0,0 +1,39 @@
#lang racket/base
(require "../main.rkt" sugar/define)
(module+ test
(require rackunit "../main.rkt"))
(define+provide+safe (attr-ref* tx key)
(txexpr? can-be-txexpr-attr-key? . -> . txexpr-attr-values?)
(define results empty)
(let loop ([tx tx])
(when (and (txexpr? tx) (attrs-have-key? tx key) (attr-ref tx key))
(set! results (cons (attr-ref tx key) results))
(map loop (get-elements tx))
(void)))
(reverse results))
(module+ test
(check-txexprs-equal? (attr-ref* '(root ((foo "bar")) "hello" "world" (meta ((foo "zam")) "bar2")
(em ((foo "zam")) "goodnight" "moon")) 'foo) '("bar" "zam" "zam"))
(check-txexprs-equal? (attr-ref* '(root ((foo "bar")) "hello" "world" (meta ((foo "zam")) "bar2")
(em ((foo "zam")) "goodnight" "moon")) 'nonexistent-key) '()))
;; convert list of alternating keys & values to attr
;; with override behavior (using hash)
(define+provide+safe (merge-attrs . items)
(() #:rest list-of-can-be-txexpr-attrs? . ->* . txexpr-attrs?)
(hash->attrs (apply (λ xs (attrs->hash #:hash-style? #t xs)) items)))
(module+ test
(check-true (attrs-equal? (merge-attrs 'foo "bar") '((foo "bar"))))
(check-true (attrs-equal? (merge-attrs '(foo "bar")) '((foo "bar"))))
(check-true (attrs-equal? (merge-attrs '((foo "bar"))) '((foo "bar"))))
(check-true (attrs-equal? (merge-attrs "foo" 'bar) '((foo "bar"))))
(check-true (attrs-equal? (merge-attrs "foo" "bar" "goo" "gar") '((foo "bar")(goo "gar"))))
(check-true (attrs-equal? (merge-attrs (merge-attrs "foo" "bar" "goo" "gar") "hee" "haw")
'((foo "bar")(goo "gar")(hee "haw"))))
(check-true (attrs-equal? (merge-attrs '((foo "bar")(goo "gar")) "foo" "haw") '((foo "haw")(goo "gar")))))
Loading…
Cancel
Save