diff --git a/main.rkt b/main.rkt index 0db5ad2..52eb2b7 100644 --- a/main.rkt +++ b/main.rkt @@ -10,7 +10,8 @@ "list.rkt" "misc.rkt" "string.rkt" - "len.rkt") + "len.rkt" + "xml.rkt") (provide (all-from-out @@ -23,4 +24,5 @@ "list.rkt" "misc.rkt" "string.rkt" - "len.rkt")) \ No newline at end of file + "len.rkt" + "xml.rkt")) \ No newline at end of file diff --git a/scribblings/sugar.scrbl b/scribblings/sugar.scrbl index a2dd5b3..a5554e7 100644 --- a/scribblings/sugar.scrbl +++ b/scribblings/sugar.scrbl @@ -34,6 +34,8 @@ A collection of small functions to help make Racket code simpler & more readable @include-section["string.scrbl"] +@include-section["xml.scrbl"] + @include-section["license.scrbl"] @;index-section[] diff --git a/scribblings/xml.scrbl b/scribblings/xml.scrbl new file mode 100644 index 0000000..9d1c16e --- /dev/null +++ b/scribblings/xml.scrbl @@ -0,0 +1,42 @@ +#lang scribble/manual + +@(require scribble/eval (for-label racket sugar xml)) + +@(define my-eval (make-base-eval)) +@(my-eval `(require sugar)) + +@title{XML} +@defmodule[sugar/xml] + +Making it easier to do the simplest kind of round-trip with XML: convert an XML string to X-expressions, manipulate, and then convert these X-expressions back to an XML string. + +@defproc[ +(xml-string->xexprs +[xml-string string?]) +(values xexpr? xexpr?)] +Take a string containg XML and break it into two X-expressions: one representing the prolog of the document, and the other representing everything under the root node. Your @racket[_xml-string] must have a root node, but it doesn't need a prolog. + +@examples[#:eval my-eval +(define str "\nhello") +(xml-string->xexprs str) +(define root-only "hello") +(xml-string->xexprs root-only) +(define prolog-only "") +(xml-string->xexprs prolog-only) +] + + +@defproc[ +(xexprs->xml-string +[prolog-xexpr xexpr?] +[root-xexpr xexpr?]) +string?] +Take two X-expressions representing the prolog and root of an XML document and join them back into an XML string. In other words, the inverse of the function above. + +@examples[#:eval my-eval +(define str "\nhello") +(define-values (prolog doc) (xml-string->xexprs str)) +prolog +doc +(xexprs->xml-string prolog doc)] + diff --git a/tests.rkt b/tests.rkt index 5343f34..6179dd2 100644 --- a/tests.rkt +++ b/tests.rkt @@ -177,3 +177,11 @@ (check-exn exn:fail? (λ() (shift xs -10))) (check-equal? (values->list (shift/values xs '(-1 0 1) 'boing)) `((1 2 3 4 boing) ,xs (boing 0 1 2 3))) + + +(require xml) +(define str "\nhello world") +(define-values (str-prolog str-doc) (xml-string->xexprs str)) +(check-equal? str-prolog (prolog (list (p-i (location 1 0 1) (location 1 38 39) 'xml "version=\"1.0\" encoding=\"utf-8\"")) #f null)) +(check-equal? str-doc '(root () "hello world")) +(check-equal? (xexprs->xml-string str-prolog str-doc) str) \ No newline at end of file diff --git a/xml.rkt b/xml.rkt new file mode 100644 index 0000000..4c2b46e --- /dev/null +++ b/xml.rkt @@ -0,0 +1,12 @@ +#lang racket/base +(require xml racket/port racket/contract) +(provide (all-defined-out)) + +(define/contract (xml-string->xexprs str) + (string? . -> . (values xexpr? xexpr?)) + (define xml-doc (with-input-from-string str (λ _ (permissive-xexprs #t) (read-xml)))) + (values (xml->xexpr (document-prolog xml-doc)) (xml->xexpr (document-element xml-doc)))) + +(define/contract (xexprs->xml-string prolog-xexpr root-xexpr) + (xexpr? xexpr? . -> . string?) + (with-output-to-string (λ _ (write-xml (document (xexpr->xml prolog-xexpr) (xexpr->xml root-xexpr) null))))) \ No newline at end of file