many changes

dev-validator
Matthew Butterick 11 years ago
parent 47af4fd3e5
commit ef82778274

@ -1,4 +1,4 @@
#lang info #lang info
(define collection "tagged-xexpr") (define collection "txexpr")
(define scribblings '(("scribblings/tagged-xexpr.scrbl" ()))) (define scribblings '(("scribblings/txexpr.scrbl" ())))

@ -12,139 +12,184 @@
(provide (contract-out [name contract])) (provide (contract-out [name contract]))
(define name body ...))])) (define name body ...))]))
;; a tagged-xexpr consists of a tag, optional attributes, and then elements. (define+provide/contract (txexpr-tag? x)
(define+provide/contract (tagged-xexpr-tag? x)
(any/c . -> . boolean?) (any/c . -> . boolean?)
(symbol? x)) (symbol? x))
(define+provide/contract (txexpr-attr? x)
(define+provide/contract (tagged-xexpr-attr? x)
(any/c . -> . boolean?) (any/c . -> . boolean?)
(match x (match x
[(list (? symbol?) (? string?)) #t] [(list (? symbol?) (? string?)) #t]
[else #f])) [else #f]))
(define+provide/contract (tagged-xexpr-attrs? x) (define+provide/contract (txexpr-attrs? x)
(any/c . -> . boolean?) (any/c . -> . boolean?)
(match x (match x
[(list (? tagged-xexpr-attr?) ...) #t] [(list (? txexpr-attr?) ...) #t]
[else #f])) [else #f]))
(define+provide/contract (tagged-xexpr-element? x) (define+provide/contract (txexpr-element? x)
(any/c . -> . boolean?) (any/c . -> . boolean?)
(or (string? x) (tagged-xexpr? x) (symbol? x) (or (string? x) (txexpr? x) (symbol? x)
(valid-char? x) (cdata? x))) (valid-char? x) (cdata? x)))
(define+provide/contract (tagged-xexpr-elements? x) (define+provide/contract (txexpr-elements? x)
(any/c . -> . boolean?) (any/c . -> . boolean?)
(match x (match x
[(list elem ...) (andmap tagged-xexpr-element? elem)] [(list elem ...) (andmap txexpr-element? elem)]
[else #f])) [else #f]))
;; is it a named x-expression? ;; is it a named x-expression?
;; todo: rewrite this recurively so errors can be pinpointed (for debugging) ;; todo: rewrite this recurively so errors can be pinpointed (for debugging)
(define+provide/contract (tagged-xexpr? x) (define+provide/contract (txexpr? x)
(any/c . -> . boolean?) (any/c . -> . boolean?)
(and (xexpr? x) ; meets basic xexpr contract (and (xexpr? x) ; meets basic xexpr contract
(match x (match x
;; is a list starting with a symbol [(list (? symbol? name) rest ...) ;; is a list starting with a symbol
[(list (? symbol? name) rest ...) (or (empty? rest)
;; the rest is content or ... (andmap txexpr-element? rest) ;; the rest is content or ...
(or (andmap tagged-xexpr-element? rest) (and (txexpr-attrs? (car rest)) (andmap txexpr-element? (cdr rest))))] ;; attr + content
;; attr + content
(and (tagged-xexpr-attrs? (car rest)) (andmap tagged-xexpr-element? (cdr rest))))]
[else #f]))) [else #f])))
(define+provide/contract (make-txexpr tag [attrs empty] [elements empty])
(define+provide/contract (make-tagged-xexpr tag [attrs empty] [elements empty])
;; todo?: use xexpr/c provides a nicer error message ;; todo?: use xexpr/c provides a nicer error message
((symbol?) (tagged-xexpr-attrs? (listof tagged-xexpr-element?)) ((symbol?) (txexpr-attrs? (listof txexpr-element?))
. ->* . tagged-xexpr?) . ->* . txexpr?)
(filter-not empty? `(,tag ,attrs ,@elements))) (filter-not empty? `(,tag ,attrs ,@elements)))
(define+provide/contract (tagged-xexpr->values x) (define+provide/contract (txexpr->values x)
(tagged-xexpr? . -> . (txexpr? . -> .
(values symbol? tagged-xexpr-attrs? (listof tagged-xexpr-element?))) (values symbol? txexpr-attrs? (listof txexpr-element?)))
(match (match
; tagged-xexpr may or may not have attr ; txexpr may or may not have attr
; if not, add empty attr so that decomposition only handles one case ; if not, add empty attr so that decomposition only handles one case
(match x (match x
[(list _ (? tagged-xexpr-attrs?) _ ...) x] [(list _ (? txexpr-attrs?) _ ...) x]
[else `(,(car x) ,empty ,@(cdr x))]) [else `(,(car x) ,empty ,@(cdr x))])
[(list tag attr content ...) (values tag attr content)])) [(list tag attr content ...) (values tag attr content)]))
(define+provide/contract (tagged-xexpr->list x) (define+provide/contract (txexpr->list x)
(tagged-xexpr? . -> . list?) (txexpr? . -> . list?)
(define-values (tag attrs content) (tagged-xexpr->values x)) (define-values (tag attrs content) (txexpr->values x))
(list tag attrs content)) (list tag attrs content))
;; convenience functions to retrieve only one part of tagged-xexpr ;; convenience functions to retrieve only one part of txexpr
(define+provide/contract (tagged-xexpr-tag x) (define+provide/contract (get-tag x)
(tagged-xexpr? . -> . tagged-xexpr-tag?) (txexpr? . -> . txexpr-tag?)
(car x)) (car x))
(define+provide/contract (tagged-xexpr-attrs x) (define+provide/contract (get-attrs x)
(tagged-xexpr? . -> . tagged-xexpr-attrs?) (txexpr? . -> . txexpr-attrs?)
(define-values (tag attrs content) (tagged-xexpr->values x)) (define-values (tag attrs content) (txexpr->values x))
attrs) attrs)
(define+provide/contract (tagged-xexpr-elements x) (define+provide/contract (get-elements x)
(tagged-xexpr? . -> . (listof tagged-xexpr-element?)) (txexpr? . -> . (listof txexpr-element?))
(define-values (tag attrs elements) (tagged-xexpr->values x)) (define-values (tag attrs elements) (txexpr->values x))
elements) elements)
;; helpers. we are getting a string or symbol ;; helpers. we are getting a string or symbol
(define (->symbol x) (define+provide/contract (->txexpr-attr-key x)
(can-be-txexpr-attr-key? . -> . txexpr-attr-key?)
(if (string? x) (string->symbol x) x)) (if (string? x) (string->symbol x) x))
(define (->string x) (define+provide/contract (->txexpr-attr-value x)
(if (symbol? x) (symbol->string x) x)) (can-be-txexpr-attr-value? . -> . txexpr-attr-value?)
(->string x))
(define+provide/contract (txexpr-attr-key? x)
(any/c . -> . boolean?)
(symbol? x))
;; convert list of alternating keys & values to attr (define+provide/contract (can-be-txexpr-attr-key? x)
(define+provide/contract (merge-attrs . items) (any/c . -> . boolean?)
(() #:rest (listof (or/c tagged-xexpr-attr? tagged-xexpr-attrs? symbol? string?)) . ->* . tagged-xexpr-attrs?) (or (symbol? x) (string? x)))
(define+provide/contract (txexpr-attr-value? x)
(any/c . -> . boolean?)
(string? x))
(define+provide/contract (can-be-txexpr-attr-value? x)
(any/c . -> . boolean?)
(can-be-txexpr-attr-key? x))
;; need this function to make sure that 'foo and "foo" are treated as the same hash key (define+provide/contract (->string x)
(define (make-attr-list items) (any/c . -> . string?)
(if (symbol? x) (symbol->string x) x))
(define+provide/contract (can-be-txexpr-attrs? x)
(any/c . -> . boolean?)
((or/c txexpr-attr? txexpr-attrs? can-be-txexpr-attr-key? can-be-txexpr-attr-value?) x))
(define+provide/contract (attrs->hash . items)
(() #:rest (listof can-be-txexpr-attrs?) . ->* . hash?)
;; 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
(define (make-key-value-list items)
(if (empty? items) (if (empty? items)
empty empty
(let ([key (->symbol (first items))] (let ([key (->txexpr-attr-key (first items))]
[value (->string (second items))] [value (->txexpr-attr-value (second items))]
[rest (drop items 2)]) [rest (drop items 2)])
(append (list key value) (make-attr-list rest))))) (cons (cons key value) (make-key-value-list rest)))))
(make-immutable-hash (make-key-value-list (flatten items))))
(define+provide/contract (hash->attrs hash)
(hash? . -> . txexpr-attrs?)
(hash-map hash list))
(define+provide/contract (attr-set tx key value)
(txexpr? can-be-txexpr-attr-key? can-be-txexpr-attr-value? . -> . txexpr?)
(define new-attrs
(hash->attrs (hash-set (attrs->hash (get-attrs tx)) (->txexpr-attr-key key) (->txexpr-attr-value value))))
(make-txexpr (get-tag tx) new-attrs (get-elements tx)))
;; use hash to ensure keys are unique (later values will overwrite earlier)
(define attr-hash (apply hash (make-attr-list (flatten items)))) (define+provide/contract (attr-ref tx key)
`(,@(map (λ(k) (list k (hash-ref attr-hash k))) (txexpr? can-be-txexpr-attr-key? . -> . txexpr-attr-value?)
;; sort needed for predictable results for unit tests (with-handlers ([exn:fail? (λ(e) (error (format "attr-ref: no value found for key ~v" key)))])
(sort (hash-keys attr-hash) (λ(a b) (string<? (->string a) (->string b))))))) (hash-ref (attrs->hash (get-attrs tx)) key)))
;; convert list of alternating keys & values to attr
(define+provide/contract (merge-attrs . items)
(() #:rest (listof can-be-txexpr-attrs?) . ->* . txexpr-attrs?)
(define attrs-hash (apply attrs->hash items))
;; sort needed for predictable results for unit tests
(define sorted-hash-keys (sort (hash-keys attrs-hash) (λ(a b) (string<? (->string a) (->string b)))))
`(,@(map (λ(key) (list key (hash-ref attrs-hash key))) sorted-hash-keys)))
(define+provide/contract (remove-attrs x) (define+provide/contract (remove-attrs x)
(tagged-xexpr? . -> . tagged-xexpr?) (txexpr? . -> . txexpr?)
(match x (cond
[(? tagged-xexpr?) (let-values ([(tag attr elements) (tagged-xexpr->values x)]) [(txexpr? x) (let-values ([(tag attr elements) (txexpr->values x)])
(make-tagged-xexpr tag empty (remove-attrs elements)))] (make-txexpr tag empty (remove-attrs elements)))]
[(? list?) (map remove-attrs x)] [(txexpr-elements? x) (map remove-attrs x)]
[else x])) [else x]))
;; todo: exclude-proc will keep things out, but is there a way to keep things in?
(define+provide/contract (map-elements/exclude proc x exclude-test)
(procedure? txexpr? procedure? . -> . txexpr?)
(cond
[(txexpr? x)
(if (exclude-test x)
x
(let-values ([(tag attr elements) (txexpr->values x)])
(make-txexpr tag attr
(map (λ(x)(map-elements/exclude proc x exclude-test)) elements))))]
;; externally the function only accepts txexpr,
;; but internally we don't care
[else (proc x)]))
(define+provide/contract (map-elements proc x) (define+provide/contract (map-elements proc x)
(procedure? tagged-xexpr? . -> . tagged-xexpr?) (procedure? txexpr? . -> . txexpr?)
(define-values (tag attr elements) (tagged-xexpr->values x)) (map-elements/exclude proc x (λ(x) #f)))
(define recursive-proc
(λ(x)
(cond
[(tagged-xexpr? x) (map-elements proc x)]
[else (proc x)])))
(make-tagged-xexpr tag attr (map recursive-proc elements)))

@ -1,264 +0,0 @@
#lang scribble/manual
@(require scribble/eval (for-label racket "../main.rkt" xml))
@(define my-eval (make-base-eval))
@(my-eval `(require tagged-xexpr xml))
@title{tagged-xexpr}
@author[(author+email "Matthew Butterick" "mb@mbtype.com")]
A set of small but handy functions for improving the readability and reliability of programs that operate on tagged X-expressions (aka tagged-xexprs).
@section{Installation}
At the command line:
@verbatim{raco pkg install tagged-xexpr}
After that, you can update the package from the command line:
@verbatim{raco pkg update tagged-xexpr}
@section{Whats a tagged-xexpr?}
It's an X-expression with the following grammar:
@racketgrammar*[
#:literals (cons list symbol? string? xexpr?)
[tagged-xexpr (list tag (list attr ...) element ...)
(cons tag (list element ...))]
[tag symbol?]
[attr (list symbol? string?)]
[element xexpr?]
]
A tagged X-expression 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 tagged X-expression can have a list of @italic{attributes} in the second position.
@examples[#:eval my-eval
(tagged-xexpr? '(span "Brennan" "Dale"))
(tagged-xexpr? '(span "Brennan" (em "Richard") "Dale"))
(tagged-xexpr? '(span [[class "hidden"][id "names"]] "Brennan" "Dale"))
(tagged-xexpr? '(span lt gt amp))
(tagged-xexpr? '("We really" "should have" "a tag"))
(tagged-xexpr? '(span [[class not-quoted]] "Brennan"))
(tagged-xexpr? '(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 tagged-xexpr within the first tagged-xexpr, 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 tagged-xexpr. See also @racket[xexpr-drop-empty-attributes].}
@examples[#:eval my-eval
(tagged-xexpr-attrs '(span [class "hidden"] "Brennan" "Dale"))
(tagged-xexpr-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:
@examples[#:eval my-eval
(xexpr->string '(span [[id "names"]] "Brennan" (em "Richard") "Dale"))
(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.
@section{Why not just use @exec{match}, @exec{quasiquote}, and so on?}
If you prefer those, please do. But I've found two benefits to using module functions:
@bold{Readability.} In code that already has a lot of matching and quasiquoting going on, these functions make it easy to see where & how tagged-xexprs are being used.
@bold{Reliability.} Because tagged-xexprs come in two close but not quite equal forms, careful coders will always have to take both cases into account.
The programming is trivial, but the annoyance is real.
@section{Interface}
@defmodule[tagged-xexpr]
@deftogether[(
@defproc[
(tagged-xexpr?
[v any/c])
boolean?]
@defproc[
(tagged-xexpr-tag?
[v any/c])
boolean?]
@defproc[
(tagged-xexpr-attr?
[v any/c])
boolean?]
@defproc[
(tagged-xexpr-element?
[v any/c])
boolean?]
)]
Predicates for @racket[_tagged-xexpr]s that implement this grammar:
@racketgrammar*[
#:literals (cons list symbol? string? xexpr?)
[tagged-xexpr (list tag (list attr ...) element ...)
(cons tag (list element ...))]
[tag symbol?]
[attr (list symbol? string?)]
[element xexpr?]
]
@deftogether[(
@defproc[
(tagged-xexpr-attrs?
[v any/c])
boolean?]
@defproc[
(tagged-xexpr-elements?
[v any/c])
boolean?]
)]
Shorthand for @code{(listof tagged-xexpr-attr?)} and @code{(listof tagged-xexpr-element?)}.
@defproc[
(tagged-xexpr->values
[tx tagged-xexpr?])
(values tagged-xexpr-tag? tagged-xexpr-attrs? tagged-xexpr-elements?)]
Dissolves a @racket[_tagged-xexpr] into its components and returns all three.
@examples[#:eval my-eval
(tagged-xexpr->values '(div))
(tagged-xexpr->values '(div "Hello" (p "World")))
(tagged-xexpr->values '(div [[id "top"]] "Hello" (p "World")))
]
@defproc[
(tagged-xexpr->list
[tx tagged-xexpr?])
(list tagged-xexpr-tag?
tagged-xexpr-attrs?
tagged-xexpr-elements?)]
Like @racket[tagged-xexpr->values], but returns the three components in a list.
@examples[#:eval my-eval
(tagged-xexpr->list '(div))
(tagged-xexpr->list '(div "Hello" (p "World")))
(tagged-xexpr->list '(div [[id "top"]] "Hello" (p "World")))
]
@deftogether[(
@defproc[
(tagged-xexpr-tag
[tx tagged-xexpr?])
tagged-xexpr-tag?]
@defproc[
(tagged-xexpr-attrs
[tx tagged-xexpr?])
tagged-xexpr-attr?]
@defproc[
(tagged-xexpr-elements
[tx tagged-xexpr?])
(listof tagged-xexpr-element?)]
)]
Accessor functions for the individual pieces of a @racket[_tagged-xexpr].
@examples[#:eval my-eval
(tagged-xexpr-tag '(div [[id "top"]] "Hello" (p "World")))
(tagged-xexpr-attrs '(div [[id "top"]] "Hello" (p "World")))
(tagged-xexpr-elements '(div [[id "top"]] "Hello" (p "World")))
]
@defproc[
(make-tagged-xexpr
[tag tagged-xexpr-tag?]
[attrs tagged-xexpr-attrs? @empty]
[elements tagged-xexpr-elements? @empty])
tagged-xexpr?]
Assemble a @racket[_tagged-xexpr] 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
(make-tagged-xexpr 'div)
(make-tagged-xexpr 'div '() '("Hello" (p "World")))
(make-tagged-xexpr 'div '[[id "top"]])
(make-tagged-xexpr 'div '[[id "top"]] '("Hello" (p "World")))
(define tx '(div [[id "top"]] "Hello" (p "World")))
(make-tagged-xexpr (tagged-xexpr-tag tx)
(tagged-xexpr-attrs tx) (tagged-xexpr-elements tx))
]
@defproc[
(merge-attrs
[attrs (listof (or/c tagged-xexpr-attr? tagged-xexpr-attrs?
symbol? string?))] ...)
tagged-xexpr-attrs?]
Combine a series of attributes into a single @racket[_tagged-xexpr-attrs] item. This function addresses three annoyances that surface in working with tagged-xexpr attributes.
@itemlist[#:style 'ordered
@item{You can pass the attributes in multiple forms. The list of arguments can include single @racket[_xexpr-attr]s, lists of @racket[_xexpr-attr]s (i.e., what you get from @racket[tagged-xexpr-attrs]), or interleaved symbols and strings (each pair will be concatenated into a single @racket[_xexpr-attr]).}
@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 (tagged-xexpr-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[
(remove-attrs
[tx tagged-xexpr?])
tagged-xexpr?]
Recursively remove all attributes.
@examples[#:eval my-eval
(define tx '(div [[id "top"]] "Hello" (p [[id "lower"]] "World")))
(remove-attrs tx)
]
@defproc[
(map-elements
[proc procedure?]
[tx tagged-xexpr?])
tagged-xexpr?]
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[_tagged-xexpr]. Usually that's not what you want.
@examples[#:eval my-eval
(define tx '(div "Hello!" (p "Welcome to" (strong "Mars"))))
(define upcaser (λ(x) (if (string? x) (string-upcase x) x)))
(map 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.
@examples[#:eval my-eval
(define tx '(p "Welcome to" (strong "Mars" amp "Sons")))
(map-elements string-upcase tx)
(define upcaser (λ(x) (if (string? x) (string-upcase x) x)))
(map-elements upcaser tx)
]
@section{License & source code}
This module is licensed under the LGPL.
Source repository at @link["http://github.com/mbutterick/tagged-xexpr"]{http://github.com/mbutterick/tagged-xexpr}. Suggestions & corrections welcome.

@ -0,0 +1,384 @@
#lang scribble/manual
@(require scribble/eval (for-label racket "../main.rkt" xml))
@(define my-eval (make-base-eval))
@(my-eval `(require txexpr xml))
@title{txexpr: Tagged X-expressions}
@author[(author+email "Matthew Butterick" "mb@mbtype.com")]
A set of small but handy functions for improving the readability and reliability of programs that operate on tagged X-expressions (for short, @italic{txexpr}s).
@section{Installation}
At the command line:
@verbatim{raco pkg install txexpr}
After that, you can update the package from the command line:
@verbatim{raco pkg update txexpr}
@section{Whats a txexpr?}
It's an X-expression with the following grammar:
@racketgrammar*[
#:literals (cons list symbol? string? xexpr?)
[txexpr (list tag (list attr ...) element ...)
(cons tag (list element ...))]
[tag symbol?]
[attr (list key value)]
[key symbol?]
[value string?]
[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.
@examples[#:eval my-eval
(txexpr? '(span "Brennan" "Dale"))
(txexpr? '(span "Brennan" (em "Richard") "Dale"))
(txexpr? '(span [[class "hidden"][id "names"]] "Brennan" "Dale"))
(txexpr? '(span lt gt amp))
(txexpr? '("We really" "should have" "a tag"))
(txexpr? '(span [[class not-quoted]] "Brennan"))
(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:
@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
(get-attrs '(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:
@examples[#:eval my-eval
(xexpr->string '(span [[id "names"]] "Brennan" (em "Richard") "Dale"))
(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.
@section{Why not just use @exec{match}, @exec{quasiquote}, and so on?}
If you prefer those, please do. But I've found two benefits to using module functions:
@bold{Readability.} In code that already has a lot of matching and quasiquoting going on, these functions make it easy to see where & how txexprs are being used.
@bold{Reliability.} Because txexprs come in two close but not quite equal forms, careful coders will always have to take both cases into account.
The programming is trivial, but the annoyance is real.
@section{Interface}
@defmodule[txexpr]
@deftogether[(
@defproc[
(txexpr?
[v any/c])
boolean?]
@defproc[
(txexpr-tag?
[v any/c])
boolean?]
@defproc[
(txexpr-attr?
[v any/c])
boolean?]
@defproc[
(txexpr-attr-key?
[v any/c])
boolean?]
@defproc[
(txexpr-attr-value?
[v any/c])
boolean?]
@defproc[
(txexpr-element?
[v any/c])
boolean?]
)]
Predicates for @racket[_txexpr]s that implement this grammar:
@racketgrammar*[
#:literals (cons list symbol? string? xexpr?)
[txexpr (list tag (list attr ...) element ...)
(cons tag (list element ...))]
[tag symbol?]
[attr (list key value)]
[key symbol?]
[value string?]
[element xexpr?]
]
@deftogether[(
@defproc[
(txexpr-attrs?
[v any/c])
boolean?]
@defproc[
(txexpr-elements?
[v any/c])
boolean?]
)]
Shorthand for @code{(listof txexpr-attr?)} and @code{(listof txexpr-element?)}.
@deftogether[(
@defproc[
(can-be-txexpr-attr-key?
[v any/c])
boolean?]
@defproc[
(can-be-txexpr-attr-value?
[v any/c])
boolean?]
)]
Predicates for input arguments that are trivially converted to an attribute @racket[_key] or @racket[_value]…
@deftogether[(
@defproc[
(->txexpr-attr-key
[v can-be-txexpr-attr-key?])
txexpr-attr-key?]
@defproc[
(->txexpr-attr-value
[v can-be-txexpr-attr-value?])
txexpr-attr-value?]
)]
 with these conversion functions.
@defproc[
(txexpr->values
[tx txexpr?])
(values txexpr-tag? txexpr-attrs? txexpr-elements?)]
Dissolves a @racket[_txexpr] into its components and returns all three.
@examples[#:eval my-eval
(txexpr->values '(div))
(txexpr->values '(div "Hello" (p "World")))
(txexpr->values '(div [[id "top"]] "Hello" (p "World")))
]
@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")))
(txexpr->list '(div [[id "top"]] "Hello" (p "World")))
]
@deftogether[(
@defproc[
(get-tag
[tx txexpr?])
txexpr-tag?]
@defproc[
(get-attrs
[tx txexpr?])
txexpr-attr?]
@defproc[
(get-elements
[tx txexpr?])
(listof txexpr-element?)]
)]
Accessor functions for the individual pieces of a @racket[_txexpr].
@examples[#:eval my-eval
(get-tag '(div [[id "top"]] "Hello" (p "World")))
(get-attrs '(div [[id "top"]] "Hello" (p "World")))
(get-elements '(div [[id "top"]] "Hello" (p "World")))
]
@defproc[
(make-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
(make-txexpr 'div)
(make-txexpr 'div '() '("Hello" (p "World")))
(make-txexpr 'div '[[id "top"]])
(make-txexpr 'div '[[id "top"]] '("Hello" (p "World")))
(define tx '(div [[id "top"]] "Hello" (p "World")))
(make-txexpr (get-tag tx)
(get-attrs tx) (get-elements tx))
]
@defproc[
(can-be-txexpr-attrs?
[v any/c])
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]).
@deftogether[(
@defproc[
(attrs->hash [x can-be-txexpr-attrs?] ...)
hash?]
@defproc[
(hash->attrs
[h hash?])
txexpr-attrs?]
)]
Convert @racket[_attrs] to an immutable hash, and back again.
@examples[#:eval my-eval
(define tx '(div [[id "top"][class "red"]] "Hello" (p "World")))
(attrs->hash (get-attrs tx))
(hash->attrs '#hash((class . "red") (id . "top")))
]
@defproc[
(attr-ref
[tx txexpr?]
[key can-be-txexpr-attr-key?])
txexpr-attr-value?]
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.
@examples[#:eval my-eval
(attr-ref tx 'class)
(attr-ref tx 'id)
(attr-ref tx 'nonexistent-key)
]
@defproc[
(attr-set
[tx txexpr?]
[key can-be-txexpr-attr-key?]
[value txexpr-attr-value?])
txexpr?]
Given a @racket[_txexpr], set the value of attribute @racket[_key] to @racket[_value]. The function returns 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[
(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[
(remove-attrs
[tx txexpr?])
txexpr?]
Recursively remove all attributes.
@examples[#:eval my-eval
(define tx '(div [[id "top"]] "Hello" (p [[id "lower"]] "World")))
(remove-attrs tx)
]
@defproc[
(map-elements
[proc procedure?]
[tx 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.
@examples[#:eval my-eval
(define tx '(div "Hello!" (p "Welcome to" (strong "Mars"))))
(define upcaser (λ(x) (if (string? x) (string-upcase x) x)))
(map 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.
@examples[#:eval my-eval
(define tx '(p "Welcome to" (strong "Mars" amp "Sons")))
(map-elements string-upcase tx)
(define upcaser (λ(x) (if (string? x) (string-upcase x) x)))
(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)))
]
@section{License & source code}
This module is licensed under the LGPL.
Source repository at @link["http://github.com/mbutterick/txexpr"]{http://github.com/mbutterick/txexpr}. Suggestions & corrections welcome.

@ -1,79 +1,113 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base))
(require "main.rkt" rackunit) (require "main.rkt" rackunit)
(define-syntax (values->list stx)
(syntax-case stx ()
[(_ values-expr) #'(call-with-values (λ () values-expr) list)]))
(define empty '()) (define empty '())
;; helper for comparison of values (check-true (txexpr-tag?'foo))
;; normal function won't work for this. Has to be syntax-rule (check-false (txexpr-tag? "foo"))
(define-syntax-rule (values->list vs) (check-false (txexpr-tag? 3))
(call-with-values (λ() vs) list))
(check-true (tagged-xexpr-attrs? '()))
(check-true (tagged-xexpr-attrs? '((key "value"))))
(check-true (tagged-xexpr-attrs? '((key "value") (foo "bar"))))
(check-false (tagged-xexpr-attrs? '((key "value") "foo" "bar"))) ; content, not attr
(check-false (tagged-xexpr-attrs? '(key "value"))) ; not a nested list
(check-false (tagged-xexpr-attrs? '(("key" "value")))) ; two strings
(check-false (tagged-xexpr-attrs? '((key value)))) ; two symbols
(check-true (tagged-xexpr-elements? '("p" "foo" "123")))
(check-true (tagged-xexpr-elements? '("p" "foo" 123))) ; includes number
(check-true (tagged-xexpr-elements? '(p "foo" "123"))) ; includes symbol
(check-false (tagged-xexpr-elements? "foo")) ; not a list
(check-false (tagged-xexpr-elements? '(((key "value")) "foo" "bar"))) ; includes attr
(check-false (tagged-xexpr-elements? '("foo" "bar" ((key "value"))))) ; malformed
(check-true (tagged-xexpr? '(p "foo" "bar")))
(check-true (tagged-xexpr? '(p ((key "value")) "foo" "bar")))
(check-true (tagged-xexpr? '(p 123))) ; content is a number
(check-false (tagged-xexpr? "foo")) ; not a list with symbol
(check-false (tagged-xexpr? '(p "foo" "bar" ((key "value"))))) ; malformed
(check-false (tagged-xexpr? '("p" "foo" "bar"))) ; no name
(check-equal? (merge-attrs 'foo "bar") '((foo "bar"))) (check-true (txexpr-attr? '(key "value")))
(check-equal? (merge-attrs '(foo "bar")) '((foo "bar"))) (check-false (txexpr-attr? '(key "value" "another")))
(check-equal? (merge-attrs '((foo "bar"))) '((foo "bar"))) (check-false (txexpr-attr? '(key 0 "value")))
(check-equal? (merge-attrs "foo" 'bar) '((foo "bar")))
(check-equal? (merge-attrs "foo" "bar" "goo" "gar") '((foo "bar")(goo "gar"))) (check-true (txexpr-attrs? '()))
(check-equal? (merge-attrs (merge-attrs "foo" "bar" "goo" "gar") "hee" "haw") (check-true (txexpr-attrs? '((key "value"))))
'((foo "bar")(goo "gar")(hee "haw"))) (check-true (txexpr-attrs? '((key "value") (foo "bar"))))
(check-equal? (merge-attrs '((foo "bar")(goo "gar")) "foo" "haw") '((foo "haw")(goo "gar"))) (check-false (txexpr-attrs? '((key "value") "foo" "bar"))) ; content, not attr
(check-false (txexpr-attrs? '(key "value"))) ; not a nested list
(check-false (txexpr-attrs? '(("key" "value")))) ; two strings
(check-false (txexpr-attrs? '((key value)))) ; two symbols
(check-true (txexpr-element? "string"))
(check-true (txexpr-element? 'amp))
(check-true (txexpr-element? '(p "string")))
(check-true (txexpr-element? 65)) ;; a valid-char
(check-false (txexpr-element? 0)) ;; not a valid-char
(check-true (txexpr-elements? '("p" "foo" "123")))
(check-true (txexpr-elements? '("p" "foo" 123))) ; includes number
(check-true (txexpr-elements? '(p "foo" "123"))) ; includes symbol
(check-false (txexpr-elements? "foo")) ; not a list
(check-false (txexpr-elements? '(((key "value")) "foo" "bar"))) ; includes attr
(check-false (txexpr-elements? '("foo" "bar" ((key "value"))))) ; malformed
(check-true (txexpr? '(p)))
(check-true (txexpr? '(p "foo" "bar")))
(check-true (txexpr? '(p ((key "value")) "foo" "bar")))
(check-true (txexpr? '(p 123))) ; content is a number
(check-false (txexpr? "foo")) ; not a list with symbol
(check-false (txexpr? '(p "foo" "bar" ((key "value"))))) ; malformed
(check-false (txexpr? '("p" "foo" "bar"))) ; no name
(check-equal? (make-tagged-xexpr 'p) '(p)) (check-equal? (make-txexpr 'p) '(p))
(check-equal? (make-tagged-xexpr 'p '((key "value"))) '(p ((key "value")))) (check-equal? (make-txexpr 'p '((key "value"))) '(p ((key "value"))))
(check-equal? (make-tagged-xexpr 'p empty '("foo" "bar")) '(p "foo" "bar")) (check-equal? (make-txexpr 'p empty '("foo" "bar")) '(p "foo" "bar"))
(check-equal? (make-tagged-xexpr 'p '((key "value")) (list "foo" "bar")) (check-equal? (make-txexpr 'p '((key "value")) (list "foo" "bar"))
'(p ((key "value")) "foo" "bar")) '(p ((key "value")) "foo" "bar"))
(check-equal? (values->list (tagged-xexpr->values '(p))) (check-equal? (values->list (txexpr->values '(p)))
(values->list (values 'p empty empty))) (values->list (values 'p empty empty)))
(check-equal? (values->list (tagged-xexpr->values '(p "foo"))) (check-equal? (values->list (txexpr->values '(p "foo")))
(values->list (values 'p empty '("foo")))) (values->list (values 'p empty '("foo"))))
(check-equal? (values->list (tagged-xexpr->values '(p ((key "value"))))) (check-equal? (values->list (txexpr->values '(p ((key "value")))))
(values->list (values 'p '((key "value")) empty))) (values->list (values 'p '((key "value")) empty)))
(check-equal? (values->list (tagged-xexpr->values '(p ((key "value")) "foo"))) (check-equal? (values->list (txexpr->values '(p ((key "value")) "foo")))
(values->list (values 'p '((key "value")) '("foo")))) (values->list (values 'p '((key "value")) '("foo"))))
(check-equal? (values->list (txexpr->values '(p)))
(txexpr->list '(p)))
(check-equal? (values->list (txexpr->values '(p "foo")))
(txexpr->list '(p "foo")))
(check-equal? (values->list (txexpr->values '(p ((key "value")))))
(txexpr->list '(p ((key "value")))))
(check-equal? (values->list (txexpr->values '(p ((key "value")) "foo")))
(txexpr->list '(p ((key "value")) "foo")))
(check-equal? (values->list (tagged-xexpr->values '(p))) (check-equal? (get-tag '(p ((key "value"))"foo" "bar" (em "square"))) 'p)
(tagged-xexpr->list '(p))) (check-equal? (get-attrs '(p ((key "value"))"foo" "bar" (em "square"))) '((key "value")))
(check-equal? (values->list (tagged-xexpr->values '(p "foo"))) (check-equal? (get-elements '(p ((key "value"))"foo" "bar" (em "square")))
(tagged-xexpr->list '(p "foo")))
(check-equal? (values->list (tagged-xexpr->values '(p ((key "value")))))
(tagged-xexpr->list '(p ((key "value")))))
(check-equal? (values->list (tagged-xexpr->values '(p ((key "value")) "foo")))
(tagged-xexpr->list '(p ((key "value")) "foo")))
(check-equal? (tagged-xexpr-tag '(p ((key "value"))"foo" "bar" (em "square"))) 'p)
(check-equal? (tagged-xexpr-attrs '(p ((key "value"))"foo" "bar" (em "square"))) '((key "value")))
(check-equal? (tagged-xexpr-elements '(p ((key "value"))"foo" "bar" (em "square")))
'("foo" "bar" (em "square"))) '("foo" "bar" (em "square")))
(check-equal? (->txexpr-attr-key "foo") 'foo)
(check-equal? (->txexpr-attr-key 'foo) 'foo)
(check-equal? (->txexpr-attr-value "foo") "foo")
(check-equal? (->txexpr-attr-value 'foo) "foo")
(check-equal? (attrs->hash '((foo "bar"))) '#hash((foo . "bar")))
(check-equal? (attrs->hash '((foo "bar")) '(foo "fraw")) '#hash((foo . "fraw")))
(check-equal? (attrs->hash '((foo "bar")) '(foo "fraw") 'foo "dog") '#hash((foo . "dog")))
(check-equal? (hash->attrs '#hash((foo . "bar")(hee . "haw"))) '((foo "bar")(hee "haw")))
(check-equal? (attr-ref '(p ((foo "bar"))) 'foo) "bar")
(check-equal? (attr-set '(p ((foo "bar"))) 'foo "fraw") '(p ((foo "fraw"))))
(check-equal? (merge-attrs 'foo "bar") '((foo "bar")))
(check-equal? (merge-attrs '(foo "bar")) '((foo "bar")))
(check-equal? (merge-attrs '((foo "bar"))) '((foo "bar")))
(check-equal? (merge-attrs "foo" 'bar) '((foo "bar")))
(check-equal? (merge-attrs "foo" "bar" "goo" "gar") '((foo "bar")(goo "gar")))
(check-equal? (merge-attrs (merge-attrs "foo" "bar" "goo" "gar") "hee" "haw")
'((foo "bar")(goo "gar")(hee "haw")))
(check-equal? (merge-attrs '((foo "bar")(goo "gar")) "foo" "haw") '((foo "haw")(goo "gar")))
(check-equal? (remove-attrs '(p ((foo "bar")) "hi")) '(p "hi")) (check-equal? (remove-attrs '(p ((foo "bar")) "hi")) '(p "hi"))
(check-equal? (remove-attrs '(p ((foo "bar")) "hi" (p ((foo "bar")) "hi"))) '(p "hi" (p "hi"))) (check-equal? (remove-attrs '(p ((foo "bar")) "hi" (p ((foo "bar")) "hi"))) '(p "hi" (p "hi")))
(check-equal? (map-elements (λ(x) (if (string? x) "boing" x)) (check-equal? (map-elements (λ(x) (if (string? x) "boing" x))
'(p "foo" "bar" (em "square"))) '(p "foo" "bar" (em "square")))
'(p "boing" "boing" (em "boing"))) '(p "boing" "boing" (em "boing")))

Loading…
Cancel
Save