suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

generalize `xml/plist' to read/write any plist value

Browse Source 
Merge to 5.3
This commit is contained in:
Matthew Flatt 2012-04-10 16:38:54 -06:00
parent 1914345af4
commit 3ecf06a8ba
3 changed files with 67 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/tests/xml/test.rkt
View File

@ -784,6 +784,22 @@ END
(write-plist plist out)
(close-output-port out)
(test-equal? (format "~S" plist) (read-plist in) plist))]
(test-plist-round-trip example))))))
(test-plist-round-trip example)
(let ()
(define array '(array "apple"
(true)
(false)
(integer 5)
(real 5.0)))
(test-not-false
"plist-value?"
(plist-value? array))
(test-plist-round-trip array)
(for ([v (in-list (cdr array))])
(test-not-false
"plist-value?"
(plist-value? v))
(test-plist-round-trip v))))))))
(run-tests xml-tests)

64
collects/xml/plist.rkt
View File

@ -22,20 +22,22 @@
(= 3 (length v))
(eq? (car v) 'assoc-pair)
(string? (cadr v))
(let pl-value? ([v (caddr v)])
(or (string? v)
(and (pair? v)
(case (car v)
[(true) (null? (cdr v))]
[(false) (null? (cdr v))]
[(integer) (and (= (length v) 2)
(exact-integer? (cadr v)))]
[(real) (and (= (length v) 2)
(real? (cadr v)))]
[(array) (andmap pl-value? (cdr v))]
[else (plist-dict? v)]))))))
(plist-value? (caddr v))))
(cdr v))))
(define (plist-value? v)
(or (string? v)
(and (pair? v)
(case (car v)
[(true) (null? (cdr v))]
[(false) (null? (cdr v))]
[(integer) (and (= (length v) 2)
(exact-integer? (cadr v)))]
[(real) (and (= (length v) 2)
(real? (cadr v)))]
[(array) (andmap plist-value? (cdr v))]
[else (plist-dict? v)]))))
; raise-plist-exn : string mark-set xexpr symbol -> ???
(define (raise-plist-exn tag mark-set xexpr type)
@ -122,18 +124,17 @@
; write-plist : xexpr port -> (void)
(define (write-plist xexpr port)
(let ([plist-xexpr `(plist ,(expand-dict xexpr))])
(write-xml
(make-document (make-prolog (list (make-p-i #f #f 'xml "version=\"1.0\" encoding=\"UTF-8\""))
(make-document-type 'plist
(make-external-dtd/system
"http://www.apple.com/DTDs/PropertyList-1.0.dtd")
#f)
empty)
(xexpr->xml `(plist ((version "0.9"))
,(expand-dict xexpr)))
null)
port)))
(write-xml
(make-document (make-prolog (list (make-p-i #f #f 'xml "version=\"1.0\" encoding=\"UTF-8\""))
(make-document-type 'plist
(make-external-dtd/system
"http://www.apple.com/DTDs/PropertyList-1.0.dtd")
#f)
empty)
(xexpr->xml `(plist ((version "0.9"))
,(expand-value xexpr)))
null)
port))
; collapse-dict : xexpr -> dict
@ -166,7 +167,7 @@
(define tags-without-whitespace
'(plist dict array))
; read-plist : port -> dict
; read-plist : port -> value
(define (read-plist port)
(let* ([xml-doc (read-xml port)]
[content (parameterize ([xexpr-drop-empty-attributes #t])
@ -175,9 +176,12 @@
(document-element xml-doc))))])
(unless (eq? (car content) 'plist)
(error 'read-plist "xml expression is not a plist: ~a" content))
(collapse-dict (caddr content))))
(collapse-value (caddr content))))
(provide
(contract-out
[plist-dict? (any/c . -> . boolean?)]
[plist-value? (any/c . -> . boolean?)]
[read-plist (input-port? . -> . plist-value?)]
[write-plist (plist-value? output-port? . -> . void?)]))
(provide/contract
[plist-dict? (any/c . -> . boolean?)]
[read-plist (input-port? . -> . plist-dict?)]
[write-plist (plist-dict? output-port? . -> . void?)])

26
collects/xml/xml.scrbl
View File

@ -387,34 +387,40 @@ used to store dictionaries of string--value associations. This format
is used by Mac OS X (both the operating system and its applications)
to store all kinds of data.
A @deftech{plist dictionary} is a value that could be created by an
expression matching the following @racket[_dict-expr] grammar:
A @deftech{plist value} is a value that could be created by an
expression matching the following @racket[_pl-expr] grammar, where a
value created by a @racket[_dict-expr] is a @deftech{plist dictionary}:
@racketgrammar*[
#:literals (list quote)
[dict-expr (list 'dict assoc-pair ...)]
[assoc-pair (list 'assoc-pair string pl-value)]
[pl-value string
[pl-expr string
(list 'true)
(list 'false)
(list 'integer integer)
(list 'real real)
dict-expr
(list 'array pl-value ...)]
(list 'array pl-expr ...)]
[dict-expr (list 'dict assoc-pair ...)]
[assoc-pair (list 'assoc-pair string pl-expr)]
]
@defproc[(plist-value? [any/c v]) boolean?]{
Returns @racket[#t] if @racket[v] is a @tech{plist value},
@racket[#f] otherwise.}
@defproc[(plist-dict? [any/c v]) boolean?]{
Returns @racket[#t] if @racket[v] is a @tech{plist dictionary},
@racket[#f] otherwise.}
@defproc[(read-plist [in input-port?]) plist-dict?]{
@defproc[(read-plist [in input-port?]) plist-value?]{
Reads a plist from a port, and produces a @tech{plist dictionary}.}
Reads a plist from a port, and produces a @tech{plist value}.}
@defproc[(write-plist [dict plist-dict?] [out output-port?]) void?]{
@defproc[(write-plist [dict plist-value?] [out output-port?]) void?]{
Write a @tech{plist dictionary} to the given port.}
Write a @tech{plist value} to the given port.}
@examples[
#:eval plist-eval