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}\ - + """ 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 " spaces <* string ">" + string " 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