diff --git a/main.rkt b/main.rkt index 202518b..dd6576c 100644 --- a/main.rkt +++ b/main.rkt @@ -1,5 +1,5 @@ #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 ;; Section 2.2 of XML 1.1 @@ -11,15 +11,18 @@ (<= #xE000 i #xFFFD) (<= #x10000 i #x10FFFF)))) + (define (my-xexpr? x) (or (txexpr? x) (xexpr? x) (my-valid-char? x))) + (define+provide+safe (txexpr-short? x) predicate/c (match x [(list (? symbol? name) (? my-xexpr?) ...) #t] [else #f])) + (define+provide+safe (txexpr? x) predicate/c (or (txexpr-short? x) @@ -27,14 +30,17 @@ [(list (? symbol?) (list (list (? symbol?) (? string?)) ...) (? my-xexpr?) ...) #t] [else #f]))) + (define+provide+safe (txexpr-tag? x) predicate/c (symbol? x)) + (define+provide+safe (txexpr-tags? x) predicate/c (and (list? x) (andmap txexpr-tag? x))) + (define+provide+safe (txexpr-attr? x) predicate/c (match x @@ -46,38 +52,47 @@ predicate/c (and (list? x) (andmap txexpr-attr? x))) + (define+provide+safe (txexpr-element? x) predicate/c (my-xexpr? x)) + (define+provide+safe (txexpr-elements? x) predicate/c (and (list? x) (andmap txexpr-element? x))) + (define+provide+safe (txexpr-attr-key? x) predicate/c (symbol? x)) + (define+provide+safe (can-be-txexpr-attr-key? x) predicate/c (or (symbol? x) (string? x))) + (define+provide+safe (txexpr-attr-value? x) predicate/c (string? x)) + (define+provide+safe (txexpr-attr-values? x) predicate/c (and (list? x) (andmap txexpr-attr-value? x))) + (define+provide+safe (can-be-txexpr-attr-value? x) predicate/c (or (symbol? x) (string? x))) + (define+provide+safe (can-be-txexpr-attrs? x) predicate/c (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) predicate/c (and (list? xs) (andmap can-be-txexpr-attrs? xs))) @@ -179,10 +194,6 @@ (->string x)) -(define (->string x) - (if (symbol? x) (symbol->string x) x)) - - (define+provide+safe (attrs->hash . items-in) (() #:rest (listof can-be-txexpr-attrs?) . ->* . hash?) ;; 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))) +(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) (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)))]) @@ -265,7 +290,6 @@ x)) - (define+provide+safe (map-elements/exclude proc x exclude-test) (procedure? txexpr? procedure? . -> . txexpr?) (cond diff --git a/scribblings/txexpr.scrbl b/scribblings/txexpr.scrbl index f6ee679..b4ccdb2 100644 --- a/scribblings/txexpr.scrbl +++ b/scribblings/txexpr.scrbl @@ -345,7 +345,7 @@ Returns @racket[#t] if @racket[_attrs] and @racket[_other-attrs] contain the sam (attr-ref [tx txexpr?] [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. @examples[#:eval my-eval @@ -358,7 +358,7 @@ Given a @racket[_key], look up the corresponding @racket[_value] in the attribut (attr-ref* [tx txexpr?] [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]. @examples[#:eval my-eval @@ -372,9 +372,9 @@ Like @racket[attr-ref], but returns a recursively gathered list of all the @rack (attr-set [tx txexpr?] [key can-be-txexpr-attr-key?] -[value txexpr-attr-value?]) +[value can-be-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]. +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"))) @@ -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") ] +@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[ (merge-attrs diff --git a/tests.rkt b/tests.rkt index 8bc9b46..8846a29 100644 --- a/tests.rkt +++ b/tests.rkt @@ -118,6 +118,14 @@ (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-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"))