diff --git a/XML/Language/XML/Attribute.idr b/XML/Language/XML/Attribute.idr
index ac016b1..f0adb43 100644
--- a/XML/Language/XML/Attribute.idr
+++ b/XML/Language/XML/Attribute.idr
@@ -2,17 +2,19 @@ module Language.XML.Attribute
import Data.String.Parser
+import public Language.XML.Name
+
public export
record Attribute where
constructor MkAttribute
- name : String
+ name : QName
value : String
%name Attribute attr
export
Show Attribute where
- show attr = "\{attr.name}=\{show attr.value}"
+ show attr = "\{show attr.name}=\{show attr.value}"
export
quotedString : Parser String
@@ -25,7 +27,7 @@ quotedString = do
export
attribute : Parser Attribute
attribute = (do
- name <- pack <$> many letter
+ name <- qName
spaces
ignore $ string "="
spaces
@@ -34,7 +36,7 @@ attribute = (do
) > "XML attribute"
export
-exactAttribute : String -> Parser String
+exactAttribute : QName -> Parser String
exactAttribute expectedName = do
MkAttribute name value <- attribute
if name == expectedName
diff --git a/XML/Language/XML/Element.idr b/XML/Language/XML/Element.idr
index d79db95..54ffa04 100644
--- a/XML/Language/XML/Element.idr
+++ b/XML/Language/XML/Element.idr
@@ -7,10 +7,11 @@ import Data.String.Extra
import Data.String.Parser
import public Language.XML.Attribute
+import public Language.XML.Name
public export
-data Element = EmptyElem String (List Attribute)
- | Elem String (List Attribute) (Odd (Maybe String) Element)
+data Element = EmptyElem QName (List Attribute)
+ | Elem QName (List Attribute) (Odd (Maybe String) Element)
%name Element elem
@@ -24,12 +25,12 @@ indentLines str = unlines $ map indent $ lines str
export
Show Element where
show (EmptyElem name attrs) =
- "<\{name}\{concat $ map (\attr => " " ++ show attr) attrs}/>"
+ "<\{show name}\{concat $ map (\attr => " " ++ show attr) attrs}/>"
show (Elem name attrs content) =
"""
- <\{name}\{concat $ map (\attr => " " ++ show attr) attrs}>\
+ <\{show name}\{concat $ map (\attr => " " ++ show attr) attrs}>\
\{indentLines $ concat $ map ("\n" ++) $ catMaybes $ forget $ mapSnd (Just . show) content}\
- \{name}>
+ \{show name}>
"""
export
@@ -44,7 +45,7 @@ export
element : Parser Element
element = (do
ignore $ string "<"
- name <- pack <$> many letter
+ name <- qName
attrs <- many (spaces *> attribute)
spaces
Nothing <- optional $ string "/>"
@@ -53,7 +54,7 @@ element = (do
content <- alternating charData element
- string "\{name}" *> spaces <* string ">"
+ string "\{show name}" *> spaces <* string ">"
pure $ Elem name attrs content
) > "XML element"
diff --git a/XML/Language/XML/Name.idr b/XML/Language/XML/Name.idr
new file mode 100644
index 0000000..7ae1e37
--- /dev/null
+++ b/XML/Language/XML/Name.idr
@@ -0,0 +1,53 @@
+module Language.XML.Name
+
+import Data.String.Parser
+
+public export
+data Name = MkName String
+
+%name Name name
+
+export
+Show Name where
+ show (MkName n) = n
+
+export
+Eq Name where
+ MkName n1 == MkName n2 = n1 == n2
+
+public export
+record QName where
+ constructor MkQName
+ namespacePrefix : Maybe Name
+ localPart : Name
+
+%name QName name
+
+export
+Show QName where
+ show (MkQName Nothing localPart) = show localPart
+ show (MkQName (Just namespacePrefix) localPart) = show namespacePrefix ++ ":" ++ show localPart
+
+export
+Eq QName where
+ n1 == n2 = n1.namespacePrefix == n2.namespacePrefix && n1.localPart == n2.localPart
+
+public export
+isNameStartChar : Char -> Bool
+isNameStartChar c = isAlpha c || c == '_'
+
+public export
+isNameChar : Char -> Bool
+isNameChar c = isAlphaNum c || c == '.' || c == '-' || c == '_'
+
+export
+name : Parser Name
+name = MkName <$> pack <$> [| satisfy isNameStartChar :: many (satisfy isNameChar) |]
+
+export
+qName : Parser QName
+qName = do
+ n <- name
+ Just localPart <- optional (char ':' *> name)
+ | Nothing => pure $ MkQName Nothing n
+ pure $ MkQName (Just n) localPart
diff --git a/XML/Language/XML/Prolog/XMLDecl.idr b/XML/Language/XML/Prolog/XMLDecl.idr
index 18b0267..9ea527b 100644
--- a/XML/Language/XML/Prolog/XMLDecl.idr
+++ b/XML/Language/XML/Prolog/XMLDecl.idr
@@ -27,9 +27,9 @@ xmlDecl : Parser XMLDecl
xmlDecl = (do
ignore $ string " exactAttribute "encoding")
- standalone <- case !(optional (spaces *> exactAttribute "standalone")) of
+ version <- exactAttribute $ MkQName Nothing $ MkName "version"
+ encoding <- optional (spaces *> exactAttribute (MkQName Nothing $ MkName "encoding"))
+ standalone <- case !(optional (spaces *> exactAttribute (MkQName Nothing $ MkName "standalone"))) of
Just "yes" => pure $ Just True
Just "no" => pure $ Just False
Nothing => pure Nothing
diff --git a/tests/XMLDocument/Element/Element.idr b/tests/XMLDocument/Element/Element.idr
index 95723e7..08f39aa 100644
--- a/tests/XMLDocument/Element/Element.idr
+++ b/tests/XMLDocument/Element/Element.idr
@@ -4,32 +4,32 @@ import Language.XML.Element
main : IO ()
main = do
- printLn $ EmptyElem "br" []
- printLn $ Elem "br" [] [Nothing]
+ printLn $ EmptyElem (MkQName Nothing (MkName "br")) []
+ printLn $ Elem (MkQName Nothing (MkName "br")) [] [Nothing]
- printLn $ EmptyElem "img" [MkAttribute "align" "left", MkAttribute "src" "https://www.w3.org/Icons/w3c_home"]
- printLn $ Elem "body" [] [Nothing, EmptyElem "hr" [], Nothing]
- printLn $ Elem "p" [MkAttribute "class" "article"] [Just "Lorem ipsum, dolor", Elem "em" [] [Just "sit"], Just "amet"]
+ printLn $ EmptyElem (MkQName Nothing (MkName "img")) [MkAttribute (MkQName Nothing (MkName "align")) "left", MkAttribute (MkQName Nothing (MkName "src")) "https://www.w3.org/Icons/w3c_home"]
+ printLn $ Elem (MkQName Nothing (MkName "body")) [] [Nothing, EmptyElem (MkQName Nothing (MkName "hr")) [], Nothing]
+ printLn $ Elem (MkQName Nothing (MkName "p")) [MkAttribute (MkQName Nothing (MkName "class")) "article"] [Just "Lorem ipsum, dolor", Elem (MkQName Nothing (MkName "em")) [] [Just "sit"], Just "amet"]
- let Right (EmptyElem "br" [], 5) = parse element "
"
+ let Right (EmptyElem (MkQName Nothing (MkName "br")) [], 5) = parse element "
"
| fail => putStrLn "Error parsing XML element, got \{show fail}"
- let Right (Elem "br" [] [Nothing], 9) = parse element "
"
+ let Right (Elem (MkQName Nothing (MkName "br")) [] [Nothing], 9) = parse element "
"
| fail => putStrLn "Error parsing XML element, got \{show fail}"
let Right (
EmptyElem
- "img"
- [MkAttribute "align" "left", MkAttribute "src" "https://www.w3.org/Icons/w3c_home"],
+ (MkQName Nothing (MkName "img"))
+ [MkAttribute (MkQName Nothing (MkName "align")) "left", MkAttribute (MkQName Nothing (MkName "src")) "https://www.w3.org/Icons/w3c_home"],
59
) = parse element #"
"#
| fail => putStrLn "Error parsing XML element, got \{show fail}"
let Right (
Elem
- "body"
+ (MkQName Nothing (MkName "body"))
[]
- [Nothing, EmptyElem "hr" [], Nothing],
+ [Nothing, EmptyElem (MkQName Nothing (MkName "hr")) [], Nothing],
24
) = parse element
"""
@@ -41,9 +41,9 @@ main = do
let Right (
Elem
- "p"
- [MkAttribute "class" "article"]
- [Just "Lorem ipsum, dolor", Elem "em" [] [Just "sit"], Just "amet"],
+ (MkQName Nothing (MkName "p"))
+ [MkAttribute (MkQName Nothing (MkName "class")) "article"]
+ [Just "Lorem ipsum, dolor", Elem (MkQName Nothing (MkName "em")) [] [Just "sit"], Just "amet"],
87
) = parse element
"""
diff --git a/tests/XMLDocument/Name/Name.idr b/tests/XMLDocument/Name/Name.idr
new file mode 100644
index 0000000..1268625
--- /dev/null
+++ b/tests/XMLDocument/Name/Name.idr
@@ -0,0 +1,20 @@
+import Data.String.Parser
+
+import Language.XML.Name
+
+main : IO ()
+main = do
+ printLn $ MkName "body"
+ printLn $ MkQName Nothing (MkName "body")
+ printLn $ MkQName (Just $ MkName "html") (MkName "body")
+
+ let Right (MkName "html", 4) = parse name "html"
+ | fail => putStrLn "Error parsing XML name, got \{show fail}"
+
+ let Right (MkQName Nothing (MkName "html"), 4) = parse qName "html"
+ | fail => putStrLn "Error parsing XML name, got \{show fail}"
+
+ let Right (MkQName (Just $ MkName "xml") (MkName "html"), 8) = parse qName "xml:html"
+ | fail => putStrLn "Error parsing XML name, got \{show fail}"
+
+ pure ()
diff --git a/tests/XMLDocument/Name/expected b/tests/XMLDocument/Name/expected
new file mode 100644
index 0000000..9bb8e21
--- /dev/null
+++ b/tests/XMLDocument/Name/expected
@@ -0,0 +1,3 @@
+body
+body
+html:body
diff --git a/tests/XMLDocument/Name/run b/tests/XMLDocument/Name/run
new file mode 100644
index 0000000..8dd32cb
--- /dev/null
+++ b/tests/XMLDocument/Name/run
@@ -0,0 +1,3 @@
+. ../../testutils.sh
+
+basicTest Name.idr
diff --git a/tests/XMLDocument/XMLDocument/XMLDocument.idr b/tests/XMLDocument/XMLDocument/XMLDocument.idr
index 3cc93a1..cd9997b 100644
--- a/tests/XMLDocument/XMLDocument/XMLDocument.idr
+++ b/tests/XMLDocument/XMLDocument/XMLDocument.idr
@@ -7,8 +7,8 @@ main = do
printLn $ MkXMLDocument
(MkXMLProlog Nothing [] Nothing [])
(Elem
- "p"
- [MkAttribute "class" "article"]
+ (MkQName Nothing (MkName "p"))
+ [MkAttribute (MkQName Nothing (MkName "class")) "article"]
[Just "Lorem ipsum, dolor sit amet"])
[]
@@ -21,17 +21,17 @@ main = do
(Just $ MkDocType "html" Nothing)
[Comment " Another comment "])
(Elem
- "p"
- [MkAttribute "class" "article"]
- [Just "Lorem ipsum, dolor", Elem "em" [] [Just "sit"], Just "amet"])
+ (MkQName Nothing (MkName "p"))
+ [MkAttribute (MkQName Nothing (MkName "class")) "article"]
+ [Just "Lorem ipsum, dolor", Elem (MkQName Nothing (MkName "em")) [] [Just "sit"], Just "amet"])
[Comment " Yet another comment "]
let Right (
MkXMLDocument
(MkXMLProlog Nothing [] Nothing [])
(Elem
- "p"
- [MkAttribute "class" "article"]
+ (MkQName Nothing (MkName "p"))
+ [MkAttribute (MkQName Nothing (MkName "class")) "article"]
[Just "Lorem ipsum, dolor sit amet"])
[],
50
@@ -46,9 +46,9 @@ main = do
(Just $ MkDocType "html" Nothing)
[Comment " Another comment "])
(Elem
- "p"
- [MkAttribute "class" "article"]
- [Just "Lorem ipsum, dolor", Elem "em" [] [Just "sit"], Just "amet"])
+ (MkQName Nothing (MkName "p"))
+ [MkAttribute (MkQName Nothing (MkName "class")) "article"]
+ [Just "Lorem ipsum, dolor", Elem (MkQName Nothing (MkName "em")) [] [Just "sit"], Just "amet"])
[Comment " Yet another comment "],
229
) = parse xmlDocument
diff --git a/tests/XMLTests.idr b/tests/XMLTests.idr
index 2c614ec..a73ea9a 100644
--- a/tests/XMLTests.idr
+++ b/tests/XMLTests.idr
@@ -14,7 +14,7 @@ miscTests = MkTestPool "Misc" [] Nothing [
documentTests : TestPool
documentTests = MkTestPool "XMLDocument" [] Nothing [
- "Element", "XMLDocument"
+ "Element", "Name", "XMLDocument"
]
main : IO ()
diff --git a/xml.ipkg b/xml.ipkg
index 61dfc00..348e68b 100644
--- a/xml.ipkg
+++ b/xml.ipkg
@@ -9,6 +9,7 @@ modules =
Language.XML.Attribute,
Language.XML.Element,
Language.XML.Misc,
+ Language.XML.Name,
Language.XML.Prolog,
Language.XML.Prolog.DocType,
Language.XML.Prolog.XMLDecl