mbutterick
/
txexpr
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

add `attr-set*` and `attr-join`

Browse Source
pull/2/head
Matthew Butterick 9 years ago
parent 8c1723e87a
commit 858e5e4e05
3 changed files with 67 additions and 10 deletions
Show Stats Download Patch File Download Diff File

36
main.rkt
Unescape Escape View File

@ -1,5 +1,5 @@
#lang racket/base #lang racket/base
(require sugar/define racket/string racket/list racket/match xml) (require sugar/define sugar/coerce racket/string racket/list racket/match xml)
(provide cdata? cdata valid-char? xexpr->string xexpr?) ; from xml (provide cdata? cdata valid-char? xexpr->string xexpr?) ; from xml
;; Section 2.2 of XML 1.1 ;; Section 2.2 of XML 1.1
@ -11,15 +11,18 @@
(<= #xE000 i #xFFFD) (<= #xE000 i #xFFFD)
(<= #x10000 i #x10FFFF)))) (<= #x10000 i #x10FFFF))))
(define (my-xexpr? x) (define (my-xexpr? x)
(or (txexpr? x) (xexpr? x) (my-valid-char? x))) (or (txexpr? x) (xexpr? x) (my-valid-char? x)))
(define+provide+safe (txexpr-short? x) (define+provide+safe (txexpr-short? x)
predicate/c predicate/c
(match x (match x
[(list (? symbol? name) (? my-xexpr?) ...) #t] [(list (? symbol? name) (? my-xexpr?) ...) #t]
[else #f])) [else #f]))
(define+provide+safe (txexpr? x) (define+provide+safe (txexpr? x)
predicate/c predicate/c
(or (txexpr-short? x) (or (txexpr-short? x)
@ -27,14 +30,17 @@
[(list (? symbol?) (list (list (? symbol?) (? string?)) ...) (? my-xexpr?) ...) #t] [(list (? symbol?) (list (list (? symbol?) (? string?)) ...) (? my-xexpr?) ...) #t]
[else #f]))) [else #f])))
(define+provide+safe (txexpr-tag? x) (define+provide+safe (txexpr-tag? x)
predicate/c predicate/c
(symbol? x)) (symbol? x))
(define+provide+safe (txexpr-tags? x) (define+provide+safe (txexpr-tags? x)
predicate/c predicate/c
(and (list? x) (andmap txexpr-tag? x))) (and (list? x) (andmap txexpr-tag? x)))
(define+provide+safe (txexpr-attr? x) (define+provide+safe (txexpr-attr? x)
predicate/c predicate/c
(match x (match x
@ -46,38 +52,47 @@
predicate/c predicate/c
(and (list? x) (andmap txexpr-attr? x))) (and (list? x) (andmap txexpr-attr? x)))
(define+provide+safe (txexpr-element? x) (define+provide+safe (txexpr-element? x)
predicate/c predicate/c
(my-xexpr? x)) (my-xexpr? x))
(define+provide+safe (txexpr-elements? x) (define+provide+safe (txexpr-elements? x)
predicate/c predicate/c
(and (list? x) (andmap txexpr-element? x))) (and (list? x) (andmap txexpr-element? x)))
(define+provide+safe (txexpr-attr-key? x) (define+provide+safe (txexpr-attr-key? x)
predicate/c predicate/c
(symbol? x)) (symbol? x))
(define+provide+safe (can-be-txexpr-attr-key? x) (define+provide+safe (can-be-txexpr-attr-key? x)
predicate/c predicate/c
(or (symbol? x) (string? x))) (or (symbol? x) (string? x)))
(define+provide+safe (txexpr-attr-value? x) (define+provide+safe (txexpr-attr-value? x)
predicate/c predicate/c
(string? x)) (string? x))
(define+provide+safe (txexpr-attr-values? x) (define+provide+safe (txexpr-attr-values? x)
predicate/c predicate/c
(and (list? x) (andmap txexpr-attr-value? x))) (and (list? x) (andmap txexpr-attr-value? x)))
(define+provide+safe (can-be-txexpr-attr-value? x) (define+provide+safe (can-be-txexpr-attr-value? x)
predicate/c predicate/c
(or (symbol? x) (string? x))) (or (symbol? x) (string? x)))
(define+provide+safe (can-be-txexpr-attrs? x) (define+provide+safe (can-be-txexpr-attrs? x)
predicate/c predicate/c
(ormap (λ(test) (test x)) (list txexpr-attr? txexpr-attrs? can-be-txexpr-attr-key? can-be-txexpr-attr-value?))) (ormap (λ(test) (test x)) (list txexpr-attr? txexpr-attrs? can-be-txexpr-attr-key? can-be-txexpr-attr-value?)))
(define+provide+safe (list-of-can-be-txexpr-attrs? xs) (define+provide+safe (list-of-can-be-txexpr-attrs? xs)
predicate/c predicate/c
(and (list? xs) (andmap can-be-txexpr-attrs? xs))) (and (list? xs) (andmap can-be-txexpr-attrs? xs)))
@ -179,10 +194,6 @@
(->string x)) (->string x))
(define (->string x)
(if (symbol? x) (symbol->string x) x))
(define+provide+safe (attrs->hash . items-in) (define+provide+safe (attrs->hash . items-in)
(() #:rest (listof can-be-txexpr-attrs?) . ->* . hash?) (() #:rest (listof can-be-txexpr-attrs?) . ->* . hash?)
;; 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
@ -231,6 +242,20 @@
(make-txexpr (get-tag tx) new-attrs (get-elements tx))) (make-txexpr (get-tag tx) new-attrs (get-elements tx)))
(define+provide+safe (attr-join tx key value)
(txexpr? can-be-txexpr-attr-key? can-be-txexpr-attr-value? . -> . txexpr?)
(define starting-values (string-split (if (attrs-have-key? tx key)
(attr-ref tx key)
"")))
(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?)
(define attrs-to-set (apply hash kvs))
(foldl (λ(kv-pair acc-tx) (attr-set acc-tx (car kv-pair) (cdr kv-pair))) tx (hash->list attrs-to-set)))
(define+provide+safe (attr-ref tx key) (define+provide+safe (attr-ref tx key)
(txexpr? can-be-txexpr-attr-key? . -> . txexpr-attr-value?) (txexpr? can-be-txexpr-attr-key? . -> . txexpr-attr-value?)
(with-handlers ([exn:fail? (λ(e) (error (format "attr-ref: no value found for key ~v" key)))]) (with-handlers ([exn:fail? (λ(e) (error (format "attr-ref: no value found for key ~v" key)))])
@ -265,7 +290,6 @@
x)) x))
(define+provide+safe (map-elements/exclude proc x exclude-test) (define+provide+safe (map-elements/exclude proc x exclude-test)
(procedure? txexpr? procedure? . -> . txexpr?) (procedure? txexpr? procedure? . -> . txexpr?)
(cond (cond

33
scribblings/txexpr.scrbl
Unescape Escape View File

@ -345,7 +345,7 @@ Returns @racket[#t] if @racket[_attrs] and @racket[_other-attrs] contain the sam
(attr-ref (attr-ref
[tx txexpr?] [tx txexpr?]
[key can-be-txexpr-attr-key?]) [key can-be-txexpr-attr-key?])
txexpr-attr-value?] can-be-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. 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 @examples[#:eval my-eval
@ -358,7 +358,7 @@ Given a @racket[_key], look up the corresponding @racket[_value] in the attribut
(attr-ref* (attr-ref*
[tx txexpr?] [tx txexpr?]
[key can-be-txexpr-attr-key?]) [key can-be-txexpr-attr-key?])
(listof txexpr-attr-value?)] (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]. 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 @examples[#:eval my-eval
@ -372,9 +372,9 @@ Like @racket[attr-ref], but returns a recursively gathered list of all the @rack
(attr-set (attr-set
[tx txexpr?] [tx txexpr?]
[key can-be-txexpr-attr-key?] [key can-be-txexpr-attr-key?]
[value 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]. The function returns the updated @racket[_txexpr]. Given a @racket[_txexpr], set the value of attribute @racket[_key] to @racket[_value]. Return the updated @racket[_txexpr].
@examples[#:eval my-eval @examples[#:eval my-eval
(define tx '(div [[class "red"][id "top"]] "Hello" (p "World"))) (define tx '(div [[class "red"][id "top"]] "Hello" (p "World")))
@ -383,6 +383,31 @@ Given a @racket[_txexpr], set the value of attribute @racket[_key] to @racket[_v
(attr-set (attr-set tx 'id "bottom") 'class "blue") (attr-set (attr-set tx 'id "bottom") 'class "blue")
] ]
@defproc[
(attr-set*
[tx txexpr?]
[key can-be-txexpr-attr-key?]
[value can-be-txexpr-attr-value?] ... ... )
txexpr?]
Like @racket[attr-set], but accepts any number of keys and values.
@examples[#:eval my-eval
(define tx '(div "Hello"))
(attr-set* tx 'id "bottom" 'class "blue")
]
@defproc[
(attr-join
[tx txexpr?]
[key can-be-txexpr-attr-key?]
[value can-be-txexpr-attr-value?])
txexpr?]
Given a @racket[_txexpr], append the value of attribute @racket[_key] with @racket[_value]. Return the updated @racket[_txexpr].
@examples[#:eval my-eval
(define tx '(div [[class "red"]] "Hello"))
(attr-join tx 'class "small")
]
@defproc[ @defproc[
(merge-attrs (merge-attrs

8
tests.rkt
Unescape Escape View File

@ -118,6 +118,14 @@
(check-equal? (attr-ref '(p ((foo "bar"))) 'foo) "bar") (check-equal? (attr-ref '(p ((foo "bar"))) 'foo) "bar")
(check-equal? (attr-set '(p ((foo "bar"))) 'foo "fraw") '(p ((foo "fraw")))) (check-equal? (attr-set '(p ((foo "bar"))) 'foo "fraw") '(p ((foo "fraw"))))
(check-equal? (attr-set* '(p ((foo "bar"))) 'foo "fraw") '(p ((foo "fraw"))))
(check-true (let ([result (attr-set* '(p ((foo "bar"))) 'foo "fraw" 'zim 'zam)])
(and (member '(foo "fraw") (get-attrs result))
(member '(zim "zam") (get-attrs result)) #t)))
(check-equal? (attr-join '(p ((foo "bar"))) 'foo "zam") '(p ((foo "bar zam"))))
(check-true (let ([result (attr-join '(p ((foo "bar"))) 'zim "zam")])
(and (member '(foo "bar") (get-attrs result))
(member '(zim "zam") (get-attrs result)) #t)))
(check-true (attrs-have-key? '(p ((color "red")(shape "circle"))) 'color)) (check-true (attrs-have-key? '(p ((color "red")(shape "circle"))) 'color))
(check-true (attrs-have-key? '(p ((color "red")(shape "circle"))) "color")) (check-true (attrs-have-key? '(p ((color "red")(shape "circle"))) "color"))

Write Preview
Loading…
Cancel
Save