add `attrs-equal?`

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

@ -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