make input arg of `attr-ref` more lenient

pull/15/head
Matthew Butterick 5 years ago
parent 55720d8e28
commit 3572318c6d

@ -235,9 +235,11 @@
(attr-set tx key (string-join (append starting-values (list value)) " "))) (attr-set tx key (string-join (append starting-values (list value)) " ")))
(define no-failure-result (gensym)) ; failure-result might be #false (define no-failure-result (gensym)) ; failure-result might be #false
(define+provide+safe (attr-ref tx key [failure-result no-failure-result]) (define+provide+safe (attr-ref attrs-arg key [failure-result no-failure-result])
((txexpr? can-be-txexpr-attr-key?) (any/c) . ->* . any) (((or/c txexpr? txexpr-attrs?) can-be-txexpr-attr-key?) (any/c) . ->* . any)
(match (assq (->txexpr-attr-key key) (get-attrs tx)) (match (assq (->txexpr-attr-key key) (match attrs-arg
[(? txexpr? tx) (get-attrs tx)]
[attrs attrs]))
[(list _ value) value] [(list _ value) value]
[_ (match failure-result [_ (match failure-result
[(? procedure?) (failure-result)] [(? procedure?) (failure-result)]

@ -372,19 +372,24 @@ Return @racket[#t] if @racket[_attrs] and @racket[_other-attrs] contain the same
@defproc[ @defproc[
(attr-ref (attr-ref
[tx txexpr?] [attrs (or/c txexpr-attrs? txexpr?)]
[key can-be-txexpr-attr-key?] [key can-be-txexpr-attr-key?]
[failure-result any/c (λ _ (raise (make-exn:fail:contract ....))) [failure-result any/c (λ _ (raise (make-exn:fail:contract ....)))
]) ])
any] any]
Given a @racket[_key], return the corresponding @racket[_value] from the attributes of a @racket[_txexpr]. By default, asking for a nonexistent key produces an error. But if a value or procedure is provided as the @racket[_failure-result], evaluate and return that instead. Given a @racket[_key], return the corresponding @racket[_value] from @racket[_attrs]. By default, asking for a nonexistent key produces an error. But if a value or procedure is provided as the @racket[_failure-result], evaluate and return that instead.
@examples[#:eval my-eval @examples[#:eval my-eval
(define tx '(div ((id "top")(class "red")) "Hello" (p "World")))
(attr-ref tx 'class) (attr-ref tx 'class)
(attr-ref tx 'id) (attr-ref tx 'id)
(attr-ref tx 'nonexistent-key) (attr-ref tx 'nonexistent-key)
(attr-ref tx 'nonexistent-key "forty-two") (attr-ref tx 'nonexistent-key "forty-two")
(attr-ref tx 'nonexistent-key (λ _ (* 6 7))) (attr-ref tx 'nonexistent-key (λ _ (* 6 7)))
(define attrs '((id "top")(class "red")))
(attr-ref attrs 'class)
(attr-ref attrs 'id)
(attr-ref attrs 'nonexistent-key)
] ]
@deftogether[( @deftogether[(

@ -150,6 +150,10 @@
(check-exn exn:fail? (λ _ (attr-ref '(p ((foo "bar"))) 'zam))) (check-exn exn:fail? (λ _ (attr-ref '(p ((foo "bar"))) 'zam)))
(check-equal? (attr-ref '(p ((foo "bar"))) 'zam 42) 42) (check-equal? (attr-ref '(p ((foo "bar"))) 'zam 42) 42)
(check-equal? (attr-ref '(p ((foo "bar"))) 'zam (λ _ (* 6 7))) 42) (check-equal? (attr-ref '(p ((foo "bar"))) 'zam (λ _ (* 6 7))) 42)
(check-equal? (attr-ref '((foo "bar")) 'foo) "bar")
(check-exn exn:fail? (λ _ (attr-ref '((foo "bar")) 'zam)))
(check-equal? (attr-ref '((foo "bar")) 'zam 42) 42)
(check-equal? (attr-ref '((foo "bar")) 'zam (λ _ (* 6 7))) 42)
(check-txexprs-equal? (attr-set '(p ((foo "bar"))) 'foo "fraw") '(p ((foo "fraw")))) (check-txexprs-equal? (attr-set '(p ((foo "bar"))) 'foo "fraw") '(p ((foo "fraw"))))
(check-txexprs-equal? (attr-set* '(p ((foo "bar"))) 'foo "fraw") '(p ((foo "fraw")))) (check-txexprs-equal? (attr-set* '(p ((foo "bar"))) 'foo "fraw") '(p ((foo "fraw"))))
(check-true (let ([result (attr-set* '(p ((foo "bar"))) 'foo "fraw" 'zim 'zam)]) (check-true (let ([result (attr-set* '(p ((foo "bar"))) 'foo "fraw" 'zim 'zam)])

Loading…
Cancel
Save