From 35de3627074a6e521e98fa55c012762912badd44 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Charlotte=20=F0=9F=A6=9D=20Delenk?= Date: Fri, 2 Sep 2022 10:07:22 +0100 Subject: [PATCH] import xml --- JSON/renderAs.dhall | 2 - Location/Type.dhall | 4 +- XML/Type.dhall | 65 +++++++++++++++++++ XML/attribute.dhall | 6 ++ XML/element.dhall | 55 ++++++++++++++++ XML/emptyAttributes.dhall | 2 + XML/leaf.dhall | 26 ++++++++ XML/package.dhall | 17 +++++ XML/rawText.dhall | 38 +++++++++++ XML/render.dhall | 128 ++++++++++++++++++++++++++++++++++++++ XML/text.dhall | 37 +++++++++++ package.dhall | 1 + 12 files changed, 376 insertions(+), 5 deletions(-) create mode 100644 XML/Type.dhall create mode 100644 XML/attribute.dhall create mode 100644 XML/element.dhall create mode 100644 XML/emptyAttributes.dhall create mode 100644 XML/leaf.dhall create mode 100644 XML/package.dhall create mode 100644 XML/rawText.dhall create mode 100644 XML/render.dhall create mode 100644 XML/text.dhall diff --git a/JSON/renderAs.dhall b/JSON/renderAs.dhall index 12f0855..e71f8be 100644 --- a/JSON/renderAs.dhall +++ b/JSON/renderAs.dhall @@ -164,8 +164,6 @@ let Format = ./Format.dhall - sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac - ? ./Format.dhall let ObjectField = { mapKey : Text, mapValue : Block } diff --git a/Location/Type.dhall b/Location/Type.dhall index dfff5b0..f0a057e 100644 --- a/Location/Type.dhall +++ b/Location/Type.dhall @@ -5,9 +5,7 @@ let Location let example0 = assert - : missing - sha256:f428188ff9d77ea15bc2bcd0da3f8ed81b304e175b07ade42a3b0fb02941b2aa as Location - ? missing as Location + : missing as Location ≡ < Environment : Text | Local : Text | Missing diff --git a/XML/Type.dhall b/XML/Type.dhall new file mode 100644 index 0000000..d891680 --- /dev/null +++ b/XML/Type.dhall @@ -0,0 +1,65 @@ +{-| +Dhall encoding of an arbitrary XML element + +For example, the following XML element: + +``` +baz +``` + +... corresponds to the following Dhall expression: + + +``` +λ(XML : Type) + → λ ( xml + : { text : + Text → XML + , rawText : + Text → XML + , element : + { attributes : + List { mapKey : Text, mapValue : Text } + , content : + List XML + , name : + Text + } + → XML + } + ) + → xml.element + { attributes = + [ { mapKey = "n", mapValue = "1" } ] + , content = + [ xml.element + { attributes = + [] : List { mapKey : Text, mapValue : Text } + , content = + [ xml.text "baz" ] + , name = + "bar" + } + ] + , name = + "foo" + } +``` +-} +let XML/Type + : Type + = ∀(XML : Type) → + ∀ ( xml + : { text : Text → XML + , rawText : Text → XML + , element : + { attributes : List { mapKey : Text, mapValue : Text } + , content : List XML + , name : Text + } → + XML + } + ) → + XML + +in XML/Type diff --git a/XML/attribute.dhall b/XML/attribute.dhall new file mode 100644 index 0000000..94bd4c4 --- /dev/null +++ b/XML/attribute.dhall @@ -0,0 +1,6 @@ +--| Builds a key-value record with a Text key and value. +let attribute + : Text → Text → { mapKey : Text, mapValue : Text } + = λ(key : Text) → λ(value : Text) → { mapKey = key, mapValue = value } + +in attribute diff --git a/XML/element.dhall b/XML/element.dhall new file mode 100644 index 0000000..079c08a --- /dev/null +++ b/XML/element.dhall @@ -0,0 +1,55 @@ +{-| +Create an XML element value. + +``` +let XML = ./package.dhall + +in XML.render + ( XML.element + { name = "foo" + , attributes = XML.emptyAttributes + , content = + [ XML.leaf { name = "bar", attributes = [ XML.attribute "n" "1" ] } + , XML.leaf { name = "baz", attributes = [ XML.attribute "n" "2" ] } + ] + } + ) + += "" +``` +-} +let XML = + ./Type.dhall + +let List/map = + ../List/map.dhall + +let Args = + { attributes : List { mapKey : Text, mapValue : Text } + , name : Text + , content : List XML + } + : Type + +let element + : Args → XML + = λ(elem : Args) → + λ(XML : Type) → + λ ( xml + : { text : Text → XML + , rawText : Text → XML + , element : + { attributes : List { mapKey : Text, mapValue : Text } + , content : List XML + , name : Text + } → + XML + } + ) → + xml.element + { attributes = elem.attributes + , name = elem.name + , content = List/map XML@1 XML (λ(x : XML@1) → x XML xml) elem.content + } + +in element diff --git a/XML/emptyAttributes.dhall b/XML/emptyAttributes.dhall new file mode 100644 index 0000000..3a449ba --- /dev/null +++ b/XML/emptyAttributes.dhall @@ -0,0 +1,2 @@ +--| Create an empty XML attribute List. +[] : List { mapKey : Text, mapValue : Text } diff --git a/XML/leaf.dhall b/XML/leaf.dhall new file mode 100644 index 0000000..0f921b8 --- /dev/null +++ b/XML/leaf.dhall @@ -0,0 +1,26 @@ +{-| +Create an XML element value without child elements. + +``` +let XML = ./package.dhall + +in XML.render (XML.leaf { name = "foobar", attributes = XML.emptyAttributes }) + += "" +``` +-} +let XML = + ./Type.dhall + +let element = + ./element.dhall + +let leaf + : { attributes : List { mapKey : Text, mapValue : Text }, name : Text } → + XML + = λ ( elem + : { attributes : List { mapKey : Text, mapValue : Text }, name : Text } + ) → + element (elem ⫽ { content = [] : List XML }) + +in leaf diff --git a/XML/package.dhall b/XML/package.dhall new file mode 100644 index 0000000..d48591e --- /dev/null +++ b/XML/package.dhall @@ -0,0 +1,17 @@ +{ Type = + ./Type.dhall +, attribute = + ./attribute.dhall +, render = + ./render.dhall +, element = + ./element.dhall +, leaf = + ./leaf.dhall +, text = + ./text.dhall +, rawText = + ./rawText.dhall +, emptyAttributes = + ./emptyAttributes.dhall +} diff --git a/XML/rawText.dhall b/XML/rawText.dhall new file mode 100644 index 0000000..d3f22a1 --- /dev/null +++ b/XML/rawText.dhall @@ -0,0 +1,38 @@ +{-| +Create a Text value to be inserted into an XML element as content with no +character escaping. + +``` +let XML = ./package.dhall + +in XML.render + ( XML.element + { name = "location" + , attributes = XML.emptyAttributes + , content = [ XML.rawText "" ] + } + ) += "" +``` +-} +let XML = + ./Type.dhall + +let rawText + : Text → XML + = λ(d : Text) → + λ(XML : Type) → + λ ( xml + : { text : Text → XML + , rawText : Text → XML + , element : + { attributes : List { mapKey : Text, mapValue : Text } + , content : List XML + , name : Text + } → + XML + } + ) → + xml.rawText d + +in rawText diff --git a/XML/render.dhall b/XML/render.dhall new file mode 100644 index 0000000..333e149 --- /dev/null +++ b/XML/render.dhall @@ -0,0 +1,128 @@ +{-| +Render an `XML` value as `Text` + +For indentation and schema validation, see the `xmllint` utility +bundled with libxml2. + +``` +let XML = ./package.dhall + +in XML.render + ( XML.element + { name = "foo" + , attributes = [ XML.attribute "a" "x", XML.attribute "b" (Natural/show 2) ] + , content = [ XML.leaf { name = "bar", attributes = XML.emptyAttributes } ] + } + ) += "" +``` + +-} +let XML = + ./Type.dhall + +let Text/concatMap = + ../Text/concatMap.dhall + +let Text/concat = + ../Text/concat.dhall + +let element = + ./element.dhall + +let text = + ./text.dhall + +let emptyAttributes = + ./emptyAttributes.dhall + +let Attr = { mapKey : Text, mapValue : Text } + +let esc = λ(x : Text) → λ(y : Text) → Text/replace x "&${y};" + +let `escape&` = esc "&" "amp" + +let `escape<` = esc "<" "lt" + +let `escape>` = esc ">" "gt" + +let `escape'` = esc "'" "apos" + +let `escape"` = esc "\"" "quot" + +let escapeCommon = λ(text : Text) → `escape<` (`escape&` text) + +let escapeAttr = λ(text : Text) → `escape"` (`escape'` (escapeCommon text)) + +let escapeText = λ(text : Text) → `escape>` (escapeCommon text) + +let renderAttr = λ(x : Attr) → " ${x.mapKey}=\"${escapeAttr x.mapValue}\"" + +let render + : XML → Text + = λ(x : XML) → + x + Text + { text = escapeText + , rawText = λ(t : Text) → t + , element = + λ ( elem + : { attributes : List { mapKey : Text, mapValue : Text } + , content : List Text + , name : Text + } + ) → + let attribs = Text/concatMap Attr renderAttr elem.attributes + + in "<${elem.name}${attribs}" + ++ ( if Natural/isZero (List/length Text elem.content) + then "/>" + else ">${Text/concat elem.content}" + ) + } + +let simple = + λ(name : Text) → + λ(content : List XML) → + element { name, attributes = emptyAttributes, content } + +let example0 = + assert + : render + ( simple + "note" + [ simple "to" [ text "Tove" ] + , simple "from" [ text "Jani" ] + , simple "heading" [ text "Reminder" ] + , simple "body" [ text "Don't forget me this weekend!" ] + ] + ) + ≡ Text/replace + "\n" + "" + '' + + Tove + Jani + Reminder + Don't forget me this weekend! + + '' + +let example1 = + assert + : render + ( element + { name = "escape" + , attributes = toMap { attribute = "<>'\"&" } + , content = [ text "<>'\"&" ] + } + ) + ≡ Text/replace + "\n" + "" + '' + <>'"& + '' + +in render diff --git a/XML/text.dhall b/XML/text.dhall new file mode 100644 index 0000000..c3145e4 --- /dev/null +++ b/XML/text.dhall @@ -0,0 +1,37 @@ +{-| +Create a Text value to be inserted into an XML element as content. + +``` +let XML = ./package.dhall + +in XML.render + ( XML.element + { name = "location" + , attributes = XML.emptyAttributes + , content = [ XML.text "/foo/bar" ] + } + ) += "/foo/bar" +``` +-} +let XML = + ./Type.dhall + +let text + : Text → XML + = λ(d : Text) → + λ(XML : Type) → + λ ( xml + : { text : Text → XML + , rawText : Text → XML + , element : + { attributes : List { mapKey : Text, mapValue : Text } + , content : List XML + , name : Text + } → + XML + } + ) → + xml.text d + +in text diff --git a/package.dhall b/package.dhall index 26ce6af..b728108 100644 --- a/package.dhall +++ b/package.dhall @@ -17,4 +17,5 @@ , Path = ./Path/package.dhall nix , Set = ./Set/package.dhall nix , Text = ./Text/package.dhall nix + , XML = ./XML/package.dhall }