diff --git a/main.rkt b/main.rkt index 832c51d..2f9a07a 100644 --- a/main.rkt +++ b/main.rkt @@ -28,7 +28,7 @@ (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) (if (not (list? x)) (format "because ~v is not a list" x) @@ -55,7 +55,7 @@ [else #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 [(or (string? x) (txexpr? x) (symbol? x) (valid-char? x) (cdata? x)) x] @@ -80,7 +80,7 @@ [(list (? symbol?)) #t] [(list (? symbol? name) (and attr-list (list (list k v ...) ...)) rest ...) (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)] [else (error (format "validate-txexpr: ~v is not a list starting with a symbol" x))]) x)) @@ -194,6 +194,15 @@ (define attrs (if (txexpr-attrs? x) x (get-attrs x))) (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) (txexpr? can-be-txexpr-attr-key? can-be-txexpr-attr-value? . -> . txexpr?) (define new-attrs @@ -223,7 +232,6 @@ [(txexpr-elements? x) (map remove-attrs x)] [else x])) - ;; 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) (procedure? txexpr? procedure? . -> . txexpr?) diff --git a/scribblings/txexpr.scrbl b/scribblings/txexpr.scrbl index 0009876..0ba63b3 100644 --- a/scribblings/txexpr.scrbl +++ b/scribblings/txexpr.scrbl @@ -315,6 +315,21 @@ Returns @racket[#t] if the @racket[_attrs] contain a value for the given @racket (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[ (attr-ref [tx txexpr?] diff --git a/tests.rkt b/tests.rkt index 601beca..192850e 100644 --- a/tests.rkt +++ b/tests.rkt @@ -92,6 +92,31 @@ (check-true (attrs-have-key? '(p ((color "red")(shape "circle"))) "color")) (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")))