import xml

This commit is contained in:
Charlotte 🦝 Delenk 2022-09-02 10:07:22 +01:00
parent f04b341fdf
commit 35de362707
Signed by: darkkirb
GPG key ID: AB2BD8DAF2E37122
12 changed files with 376 additions and 5 deletions

View file

@ -164,8 +164,6 @@
let Format =
./Format.dhall
sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac
? ./Format.dhall
let ObjectField = { mapKey : Text, mapValue : Block }

View file

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

65
XML/Type.dhall Normal file
View file

@ -0,0 +1,65 @@
{-|
Dhall encoding of an arbitrary XML element
For example, the following XML element:
```
<foo n="1"><bar>baz</bar></foo>
```
... 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

6
XML/attribute.dhall Normal file
View file

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

55
XML/element.dhall Normal file
View file

@ -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" ] }
]
}
)
= "<foo><bar n=\"1\"/><baz n=\"2\"/></foo>"
```
-}
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

View file

@ -0,0 +1,2 @@
--| Create an empty XML attribute List.
[] : List { mapKey : Text, mapValue : Text }

26
XML/leaf.dhall Normal file
View file

@ -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 })
= "<foobar/>"
```
-}
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

17
XML/package.dhall Normal file
View file

@ -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
}

38
XML/rawText.dhall Normal file
View file

@ -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 "<bar n=\"1\"/>" ]
}
)
= "<foo><bar n=\"1\"/></foo>"
```
-}
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

128
XML/render.dhall Normal file
View file

@ -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 } ]
}
)
= "<foo a=\"x\" b=\"2\"><bar/></foo>"
```
-}
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}</${elem.name}>"
)
}
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"
""
''
<note>
<to>Tove</to>
<from>Jani</from>
<heading>Reminder</heading>
<body>Don't forget me this weekend!</body>
</note>
''
let example1 =
assert
: render
( element
{ name = "escape"
, attributes = toMap { attribute = "<>'\"&" }
, content = [ text "<>'\"&" ]
}
)
≡ Text/replace
"\n"
""
''
<escape attribute="&lt;>&apos;&quot;&amp;">&lt;&gt;'"&amp;</escape>
''
in render

37
XML/text.dhall Normal file
View file

@ -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" ]
}
)
= "<location>/foo/bar</location>"
```
-}
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

View file

@ -17,4 +17,5 @@
, Path = ./Path/package.dhall nix
, Set = ./Set/package.dhall nix
, Text = ./Text/package.dhall nix
, XML = ./XML/package.dhall
}