import xml
This commit is contained in:
parent
f04b341fdf
commit
35de362707
12 changed files with 376 additions and 5 deletions
|
@ -164,8 +164,6 @@
|
|||
|
||||
let Format =
|
||||
./Format.dhall
|
||||
sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac
|
||||
? ./Format.dhall
|
||||
|
||||
let ObjectField = { mapKey : Text, mapValue : Block }
|
||||
|
||||
|
|
|
@ -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
65
XML/Type.dhall
Normal 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
6
XML/attribute.dhall
Normal 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
55
XML/element.dhall
Normal 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
|
2
XML/emptyAttributes.dhall
Normal file
2
XML/emptyAttributes.dhall
Normal file
|
@ -0,0 +1,2 @@
|
|||
--| Create an empty XML attribute List.
|
||||
[] : List { mapKey : Text, mapValue : Text }
|
26
XML/leaf.dhall
Normal file
26
XML/leaf.dhall
Normal 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
17
XML/package.dhall
Normal 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
38
XML/rawText.dhall
Normal 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
128
XML/render.dhall
Normal 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="<>'"&"><>'"&</escape>
|
||||
''
|
||||
|
||||
in render
|
37
XML/text.dhall
Normal file
37
XML/text.dhall
Normal 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
|
|
@ -17,4 +17,5 @@
|
|||
, Path = ./Path/package.dhall nix
|
||||
, Set = ./Set/package.dhall nix
|
||||
, Text = ./Text/package.dhall nix
|
||||
, XML = ./XML/package.dhall
|
||||
}
|
||||
|
|
Loading…
Reference in a new issue