add `attrs-equal?`

typed-work
Matthew Butterick 10 years ago
parent e8539fcfcf
commit b701ede767

@ -28,7 +28,7 @@
(define (validate-txexpr-attrs x #:context [txexpr-context #f]) (define (validate-txexpr-attrs x #:context [txexpr-context #f])
; ((any/c) (#:context (or/c #f txexpr?)) . ->* . txexpr-attrs?) ; ((any/c) (#:context (or/c #f txexpr?)) . ->* . txexpr-attrs?)
(define (make-reason) (define (make-reason)
(if (not (list? x)) (if (not (list? x))
(format "because ~v is not a list" x) (format "because ~v is not a list" x)
@ -55,7 +55,7 @@
[else #f])) [else #f]))
(define (validate-txexpr-element x #:context [txexpr-context #f]) (define (validate-txexpr-element x #:context [txexpr-context #f])
; ((any/c) (#:context (or/c #f txexpr?)) . ->* . txexpr-element?) ; ((any/c) (#:context (or/c #f txexpr?)) . ->* . txexpr-element?)
(cond (cond
[(or (string? x) (txexpr? x) (symbol? x) [(or (string? x) (txexpr? x) (symbol? x)
(valid-char? x) (cdata? x)) x] (valid-char? x) (cdata? x)) x]
@ -80,7 +80,7 @@
[(list (? symbol?)) #t] [(list (? symbol?)) #t]
[(list (? symbol? name) (and attr-list (list (list k v ...) ...)) rest ...) [(list (? symbol? name) (and attr-list (list (list k v ...) ...)) rest ...)
(and (validate-txexpr-attrs-with-context attr-list) (and (validate-txexpr-attrs-with-context attr-list)
(andmap validate-txexpr-element-with-context rest))] (andmap validate-txexpr-element-with-context rest))]
[(list (? symbol? name) rest ...)(andmap validate-txexpr-element-with-context rest)] [(list (? symbol? name) rest ...)(andmap validate-txexpr-element-with-context rest)]
[else (error (format "validate-txexpr: ~v is not a list starting with a symbol" x))]) [else (error (format "validate-txexpr: ~v is not a list starting with a symbol" x))])
x)) x))
@ -194,6 +194,15 @@
(define attrs (if (txexpr-attrs? x) x (get-attrs x))) (define attrs (if (txexpr-attrs? x) x (get-attrs x)))
(hash-has-key? (attrs->hash attrs) (->txexpr-attr-key key))) (hash-has-key? (attrs->hash attrs) (->txexpr-attr-key key)))
(define+provide+safe (attrs-equal? x1 x2)
((or/c txexpr-attrs? txexpr?) (or/c txexpr-attrs? txexpr?) . -> . boolean?)
(define attrs-tx1 (attrs->hash (if (txexpr-attrs? x1) x1 (get-attrs x1))))
(define attrs-tx2 (attrs->hash (if (txexpr-attrs? x2) x2 (get-attrs x2))))
(and
(= (length (hash-keys attrs-tx1)) (length (hash-keys attrs-tx2)))
(for/and ([(key value) (in-hash attrs-tx1)])
(equal? (hash-ref attrs-tx2 key) value))))
(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?)
(define new-attrs (define new-attrs
@ -223,7 +232,6 @@
[(txexpr-elements? x) (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? ;; todo: exclude-proc will keep things out, but is there a way to keep things in?
(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?)

@ -315,6 +315,21 @@ Returns @racket[#t] if the @racket[_attrs] contain a value for the given @racket
(attrs-have-key? tx 'grackle) (attrs-have-key? tx 'grackle)
] ]
@defproc[
(attrs-equal?
[attrs (or/c txexpr-attrs? txexpr?)]
[other-attrs (or/c txexpr-attrs? txexpr?)])
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.
@examples[#:eval my-eval
(define tx1 '(div [[id "top"][class "red"]] "Hello"))
(define tx2 '(p [[class "red"][id "top"]] "Hello"))
(define tx3 '(p [[id "bottom"][class "red"]] "Hello"))
(attrs-equal? tx1 tx2)
(attrs-equal? tx1 tx3)
]
@defproc[ @defproc[
(attr-ref (attr-ref
[tx txexpr?] [tx txexpr?]

@ -92,6 +92,31 @@
(check-true (attrs-have-key? '(p ((color "red")(shape "circle"))) "color")) (check-true (attrs-have-key? '(p ((color "red")(shape "circle"))) "color"))
(check-false (attrs-have-key? '((color "red")(shape "circle")) 'nonexistent)) (check-false (attrs-have-key? '((color "red")(shape "circle")) 'nonexistent))
(check-true (attrs-equal? '(p ((color "red")(shape "circle")))
'(foo ((color "red")(shape "circle")))))
(check-false (attrs-equal? '(p ((color "red")(shape "circle")))
'(foo ((color "blue")(shape "circle")))))
(check-true (attrs-equal? '(p ((color "red")(shape "circle")))
'(foo ((shape "circle")(color "red")))))
(check-false (attrs-equal? '(p ((color "red")(shape "circle")))
'(foo ((color "red")))))
(check-true (attrs-equal? '((color "red")(shape "circle"))
'((color "red")(shape "circle"))))
(check-false (attrs-equal? '((color "red")(shape "circle"))
'((color "blue")(shape "circle"))))
(check-true (attrs-equal? '((color "red")(shape "circle"))
'((shape "circle")(color "red"))))
(check-false (attrs-equal? '((color "red")(shape "circle"))
'((color "red"))))
(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")))

Loading…
Cancel
Save