Merge branch 'master' of prism.r:stockholm into new-master

1 files changed, 88 insertions, 0 deletions

diff --git a/lib/xml.nix b/lib/xml.nix
new file mode 100644
index 000000000..16052445b
--- /dev/null
+++ b/lib/xml.nix
@@ -0,0 +1,88 @@
+{ lib }:
+with lib;
+with builtins;
+rec {
+
+  # Use `term` to construct XML.
+  #
+  # Examples:
+  #
+  #   (term "bool" null null)
+  #   (term "cool" null [])
+  #   (term "fool" { hurr = "durr"; } null)
+  #   (term "hool" null [
+  #     (term "tool" null null)
+  #   ])
+  #
+  # See `render` for how these get transformed into actuall XML documents.
+  #
+  term = name: attrs: content: {
+    inherit name attrs content;
+  };
+
+  empty = term null null null;
+
+  # Ref http://www.w3.org/TR/xml/#syntax
+  #
+  # Example:
+  #
+  #   (quote "<cheez!>")                 #===>   &lt;cheez!&gt;
+  #
+  quote = let
+    sub = {
+      "&" = "&amp;";
+      "<" = "&lt;";
+      ">" = "&gt;";
+      "'" = "&apos;";
+      "\"" = "&quot;";
+    };
+  in
+    stringAsChars (c: sub.${c} or c);
+
+  # Turn an XML element to an XML document string.
+  doc = t:
+    "<?xml version='1.0' encoding='UTF-8'?>${render t}";
+
+  # Render an XML element to a string.
+  #
+  # Rendering `empty` yields the empty string.
+  #
+  # Examples:
+  #
+  #   (term "bool" null null)                 #===>   <bool/>
+  #   (term "cool" null [])                   #===>   <cool></cool>
+  #   (term "fool" { hurr = "durr"; } null)   #===>   <fool hurr="durr"/>
+  #   (term "hool" null [
+  #     (term "tool" null null)
+  #   ])                                      #===>   <hool><tool/></hool>
+  #
+  render = let
+    render-attrs = attrs:
+      getAttr (typeOf attrs) {
+        null = "";
+        set = concatStrings (mapAttrsToList (n: v: " ${n}=\"${v}\"") attrs);
+      };
+
+    render-content = content:
+      getAttr (typeOf content) {
+        bool = toJSON content;
+        int = toJSON content;
+        list = concatMapStrings render content;
+        string = quote content;
+      };
+  in
+    { name, attrs, content }:
+    # XXX we're currently encoding too much information with `null`..
+    if name == null
+      then
+        if content == null
+          then ""
+          else content
+      else let
+        attrs' = render-attrs attrs;
+        content' = render-content content;
+      in
+        if content == null
+          then "<${name}${attrs'}/>"
+          else "<${name}${attrs'}>${content'}</${name}>";
+}