add sugar/xml

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"))
+  "len.rkt"
+  "xml.rkt"))

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[]

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 "<?xml encoding=\"utf-8\"?>\n<root>hello</root>")
+(xml-string->xexprs str)
+(define root-only "<root>hello</root>")
+(xml-string->xexprs root-only)
+(define prolog-only "<?xml encoding=\"utf-8\"?>")
+(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 "<?xml encoding=\"utf-8\"?>\n<root>hello</root>")
+(define-values (prolog doc) (xml-string->xexprs str))
+prolog
+doc
+(xexprs->xml-string prolog doc)]
+

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 "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n<root>hello world</root>")
+(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)

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