xml-parser 0.1 → 0.1.0.1
raw patch · 5 files changed
+90/−84 lines, 5 files
Files
- library/XmlParser/AstParser.hs +5/−5
- library/XmlParser/Attoparsec.hs +80/−0
- library/XmlParser/NamespaceRegistry.hs +3/−3
- library/XmlParser/XmlSchemaAttoparsec.hs +0/−74
- xml-parser.cabal +2/−2
library/XmlParser/AstParser.hs view
@@ -41,12 +41,12 @@ import qualified Data.List as List import qualified Text.Builder as Tb import qualified Text.XML as Xml+import qualified XmlParser.Attoparsec as Attoparsec import qualified XmlParser.ElementDestructionState as ElementDestructionState import qualified XmlParser.NameMap as NameMap import qualified XmlParser.NamespaceRegistry as NamespaceRegistry import qualified XmlParser.NodeConsumerState as NodeConsumerState import XmlParser.Prelude-import qualified XmlParser.XmlSchemaAttoparsec as XmlSchemaAttoparsec -- | -- Parse an \"xml-conduit\" element AST.@@ -243,7 +243,7 @@ case runByName nameMap (\element (Element run) -> fmap fst (run deeperNreg element ElementDestructionState.new)) of OkByNameResult _ res -> Right (res, state) NotFoundByNameResult unfoundNames ->- let availNames = NameMap.extractNames nameMap+ let availNames = nub $ NameMap.extractNames nameMap in Left (NoneOfChildrenFoundByNameElementError unfoundNames availNames) FailedDeeperByNameResult ns name err -> Left (ChildByNameElementError ns name err)@@ -259,7 +259,7 @@ (nameMap, state) -> case runByName nameMap (\content (Content parseContent) -> parseContent (\ns -> NamespaceRegistry.lookup ns nreg) content) of OkByNameResult _ res -> Right (res, state) NotFoundByNameResult unfoundNames ->- let availNames = NameMap.extractNames nameMap+ let availNames = nub $ NameMap.extractNames nameMap in Left (NoneOfAttributesFoundByNameElementError unfoundNames availNames) FailedDeeperByNameResult ns name err -> Left (AttributeByNameElementError ns name err)@@ -413,13 +413,13 @@ -- - https://en.wikipedia.org/wiki/QName qNameContent :: Content (Maybe Text, Text) qNameContent =- Content $ \lookup content -> case Attoparsec.parseOnly XmlSchemaAttoparsec.qName content of+ Content $ \lookup content -> case Attoparsec.parseStripped Attoparsec.qName content of Right (ns, name) -> case ns of Just ns -> case lookup ns of Just uri -> Right (Just uri, name) Nothing -> Left (Just (NamespaceNotFoundContentError ns)) Nothing -> Right (Nothing, name)- Left err -> Left (Just (ParsingContentError (fromString err)))+ Left err -> Left (Just (ParsingContentError err)) -- * ByName
+ library/XmlParser/Attoparsec.hs view
@@ -0,0 +1,80 @@+module XmlParser.Attoparsec where++import Data.Attoparsec.Text+import qualified Data.Text as Text+import XmlParser.Prelude hiding (takeWhile)++parseStripped :: Parser a -> Text -> Either Text a+parseStripped p = first fromString . parseOnly (stripped p)+ where+ stripped :: Parser a -> Parser a+ stripped p = skipSpace *> p <* skipSpace <* endOfInput++qName :: Parser (Maybe Text, Text)+qName =+ {-+ Ref (from https://en.wikipedia.org/wiki/QName):++ QName ::= PrefixedName | UnprefixedName+ PrefixedName ::= Prefix ':' LocalPart+ UnprefixedName ::= LocalPart+ Prefix ::= NCName+ LocalPart ::= NCName+ -}+ do+ a <- ncName+ asum+ [ do+ char ':'+ b <- ncName+ return (Just a, b),+ return (Nothing, a)+ ]++{-# NOINLINE ncName #-}+ncName :: Parser Text+ncName =+ {-+ Ref (from https://en.wikipedia.org/wiki/QName):++ NCName ::= Name - (Char* ':' Char*) (* An XML Name, minus the ":" *)+ Name ::= NameStartChar (NameChar)*+ NameStartChar ::= ":" | [A-Z] | "_" | [a-z] | [#xC0-#xD6] | [#xD8-#xF6]+ | [#xF8-#x2FF] | [#x370-#x37D] | [#x37F-#x1FFF]+ | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF]+ | [#x3001-#xD7FF] | [#xF900-#xFDCF] | [#xFDF0-#xFFFD]+ | [#x10000-#xEFFFF]+ NameChar ::= NameStartChar | "-" | "." | [0-9]+ | #xB7 | [#x0300-#x036F] | [#x203F-#x2040]+ Char ::= (* any Unicode char, excluding surrogate blocks FFFE and FFFF. *)+ #x9 | #xA | #xD | [#x20-#xD7FF]+ | [#xE000-#xFFFD] | [#x10000-#x10FFFF]+ -}+ do+ a <- satisfy nameStartCharPredicate+ b <- takeWhile nameCharPredicate+ return (Text.cons a b)+ where+ nameStartCharPredicate x =+ x >= 'A' && x <= 'Z'+ || x == '_'+ || x >= 'a' && x <= 'z'+ || x >= '\xC0' && x <= '\xD6'+ || x >= '\xD8' && x <= '\xF6'+ || x >= '\xF8' && x <= '\x2FF'+ || x >= '\x370' && x <= '\x37D'+ || x >= '\x37F' && x <= '\x1FFF'+ || x >= '\x200C' && x <= '\x200D'+ || x >= '\x2070' && x <= '\x218F'+ || x >= '\x2C00' && x <= '\x2FEF'+ || x >= '\x3001' && x <= '\xD7FF'+ || x >= '\xF900' && x <= '\xFDCF'+ || x >= '\xFDF0' && x <= '\xFFFD'+ || x >= '\x10000' && x <= '\xEFFFF'+ nameCharPredicate x =+ x == '-' || x == '.'+ || x >= '0' && x <= '9'+ || x == '\xB7'+ || x >= '\x0300' && x <= '\x036F'+ || x >= '\x203F' && x <= '\x2040'+ || nameStartCharPredicate x
library/XmlParser/NamespaceRegistry.hs view
@@ -13,8 +13,8 @@ import qualified Data.HashMap.Strict as HashMap import qualified Data.Map.Strict as Map import qualified Text.XML as Xml+import qualified XmlParser.Attoparsec as Attoparsec import XmlParser.Prelude hiding (insert, lookup)-import qualified XmlParser.XmlSchemaAttoparsec as XmlSchemaAttoparsec data NamespaceRegistry = NamespaceRegistry@@ -43,7 +43,7 @@ Just uri -> Just (Just uri, localName) Nothing -> Nothing Nothing ->- case Attoparsec.parseOnly XmlSchemaAttoparsec.qName localName of+ case Attoparsec.parseOnly Attoparsec.qName localName of Right (ns, localName) -> case ns of Just ns -> case HashMap.lookup ns map of Just uri -> Just (Just uri, localName)@@ -66,7 +66,7 @@ interpretAttribute (Xml.Name localName namespace prefix) uri = case namespace of Nothing -> case prefix of- Nothing -> case Attoparsec.parseOnly XmlSchemaAttoparsec.qName localName of+ Nothing -> case Attoparsec.parseOnly Attoparsec.qName localName of Right (Just "xmlns", name) -> insert name uri Right (Nothing, "xmlns") -> setDefault uri _ -> id
− library/XmlParser/XmlSchemaAttoparsec.hs
@@ -1,74 +0,0 @@-module XmlParser.XmlSchemaAttoparsec where--import Data.Attoparsec.Text-import qualified Data.Text as Text-import XmlParser.Prelude hiding (takeWhile)--qName :: Parser (Maybe Text, Text)-qName =- {-- Ref (from https://en.wikipedia.org/wiki/QName):-- QName ::= PrefixedName | UnprefixedName- PrefixedName ::= Prefix ':' LocalPart- UnprefixedName ::= LocalPart- Prefix ::= NCName- LocalPart ::= NCName- -}- do- a <- ncName- asum- [ do- char ':'- b <- ncName- return (Just a, b),- return (Nothing, a)- ]--{-# NOINLINE ncName #-}-ncName :: Parser Text-ncName =- {-- Ref (from https://en.wikipedia.org/wiki/QName):-- NCName ::= Name - (Char* ':' Char*) (* An XML Name, minus the ":" *)- Name ::= NameStartChar (NameChar)*- NameStartChar ::= ":" | [A-Z] | "_" | [a-z] | [#xC0-#xD6] | [#xD8-#xF6]- | [#xF8-#x2FF] | [#x370-#x37D] | [#x37F-#x1FFF]- | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF]- | [#x3001-#xD7FF] | [#xF900-#xFDCF] | [#xFDF0-#xFFFD]- | [#x10000-#xEFFFF]- NameChar ::= NameStartChar | "-" | "." | [0-9]- | #xB7 | [#x0300-#x036F] | [#x203F-#x2040]- Char ::= (* any Unicode char, excluding surrogate blocks FFFE and FFFF. *)- #x9 | #xA | #xD | [#x20-#xD7FF]- | [#xE000-#xFFFD] | [#x10000-#x10FFFF]- -}- do- a <- satisfy nameStartCharPredicate- b <- takeWhile nameCharPredicate- return (Text.cons a b)- where- nameStartCharPredicate x =- x >= 'A' && x <= 'Z'- || x == '_'- || x >= 'a' && x <= 'z'- || x >= '\xC0' && x <= '\xD6'- || x >= '\xD8' && x <= '\xF6'- || x >= '\xF8' && x <= '\x2FF'- || x >= '\x370' && x <= '\x37D'- || x >= '\x37F' && x <= '\x1FFF'- || x >= '\x200C' && x <= '\x200D'- || x >= '\x2070' && x <= '\x218F'- || x >= '\x2C00' && x <= '\x2FEF'- || x >= '\x3001' && x <= '\xD7FF'- || x >= '\xF900' && x <= '\xFDCF'- || x >= '\xFDF0' && x <= '\xFFFD'- || x >= '\x10000' && x <= '\xEFFFF'- nameCharPredicate x =- x == '-' || x == '.'- || x >= '0' && x <= '9'- || x == '\xB7'- || x >= '\x0300' && x <= '\x036F'- || x >= '\x203F' && x <= '\x2040'- || nameStartCharPredicate x
xml-parser.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: xml-parser-version: 0.1+version: 0.1.0.1 synopsis: XML parser with informative error-reporting and simple API homepage: https://github.com/nikita-volkov/xml-parser bug-reports: https://github.com/nikita-volkov/xml-parser/issues@@ -25,6 +25,7 @@ XmlParser other-modules: XmlParser.AstParser+ XmlParser.Attoparsec XmlParser.ElementDestructionState XmlParser.NameMap XmlParser.NamespaceRegistry@@ -32,7 +33,6 @@ XmlParser.TupleHashMap XmlParser.Prelude XmlParser.XmlConduitWrapper- XmlParser.XmlSchemaAttoparsec build-depends: attoparsec >=0.13 && <0.15, base >=4.11 && <5,