packages feed

xml-parser 0.1.1.1 → 0.1.1.2

raw patch · 10 files changed

+157/−96 lines, 10 filesdep −QuickCheckdep ~bytestringdep ~containersdep ~text-builder

Dependencies removed: QuickCheck

Dependency ranges changed: bytestring, containers, text-builder, transformers, xml-conduit

Files

library/XmlParser.hs view
@@ -58,8 +58,8 @@ -- Parse XML file. parseFile :: AstParser.Element a -> FilePath -> IO (Either Text a) parseFile astParser path =-  fmap (>>= parseDocumentAst astParser) $-    XmlConduitWrapper.parseFile path+  fmap (>>= parseDocumentAst astParser)+    $ XmlConduitWrapper.parseFile path  parseDocumentAst :: AstParser.Element a -> XmlConduit.Document -> Either Text a parseDocumentAst astParser =
library/XmlParser/AstParser.hs view
@@ -39,8 +39,9 @@ import qualified Data.Attoparsec.Text as Attoparsec import qualified Data.HashMap.Strict as HashMap import qualified Data.List as List-import qualified Text.Builder as Tb import qualified Text.XML as Xml+import TextBuilder (TextBuilder)+import qualified TextBuilder import qualified XmlParser.Attoparsec as Attoparsec import qualified XmlParser.ElementDestructionState as ElementDestructionState import qualified XmlParser.NameMap as NameMap@@ -60,18 +61,18 @@  renderElementError :: ElementError -> Text renderElementError =-  Tb.run . (\(a, b) -> "/" <> Tb.intercalate "/" (reverse a) <> ": " <> b) . simplifyElementError+  TextBuilder.toText . (\(a, b) -> "/" <> TextBuilder.intercalate "/" (reverse a) <> ": " <> b) . simplifyElementError -simplifyElementError :: ElementError -> ([Tb.Builder], Tb.Builder)+simplifyElementError :: ElementError -> ([TextBuilder], TextBuilder) simplifyElementError =   elementError []   where     sortedList renderer =-      mappend "[" . flip mappend "]" . Tb.intercalate ", " . fmap renderer . sort+      mappend "[" . flip mappend "]" . TextBuilder.intercalate ", " . fmap renderer . sort     name a b =       case a of-        Just _ -> Tb.text b-        Nothing -> Tb.text b+        Just _ -> TextBuilder.text b+        Nothing -> TextBuilder.text b     elementError collectedPath = \case       NoneOfChildrenFoundByNameElementError a b ->         ( collectedPath,@@ -83,19 +84,20 @@       ChildByNameElementError a b c ->         elementError (name a b : collectedPath) c       ChildAtOffsetElementError a b ->-        nodeError (Tb.decimal a : collectedPath) b+        nodeError (TextBuilder.decimal a : collectedPath) b       AttributeByNameElementError a b c ->         (("@" <> name a b) : collectedPath, maybeContentError c)       NoneOfAttributesFoundByNameElementError a b ->         ( collectedPath,-          "Found none of the following attributes: " <> sortedList (uncurry name) a+          "Found none of the following attributes: "+            <> sortedList (uncurry name) a             <> ". The following are available: "             <> sortedList (uncurry name) b         )       NameElementError a ->-        (collectedPath, Tb.text a)+        (collectedPath, TextBuilder.text a)       UserElementError a ->-        (collectedPath, Tb.text a)+        (collectedPath, TextBuilder.text a)     nodeError collectedPath = \case       UnexpectedNodeTypeNodeError a b ->         ( collectedPath,@@ -115,15 +117,15 @@     maybeContentError = maybe "Empty alternative" contentError     contentError = \case       UserContentError a ->-        Tb.text a+        TextBuilder.text a       ParsingContentError a ->-        Tb.text a+        TextBuilder.text a       NamespaceNotFoundContentError a ->-        "Namespace not found: " <> Tb.text a+        "Namespace not found: " <> TextBuilder.text a       UnexpectedValueContentError a ->-        "Unexpected value: " <> Tb.text a+        "Unexpected value: " <> TextBuilder.text a       EnumContentError a b ->-        "Unexpected value: " <> Tb.text b <> ". Expecting one of the following: " <> sortedList Tb.text a+        "Unexpected value: " <> TextBuilder.text b <> ". Expecting one of the following: " <> sortedList TextBuilder.text a  -- | -- Error in the context of an element.@@ -135,37 +137,37 @@       Text       (Maybe ContentError)   | NoneOfAttributesFoundByNameElementError+      -- | Not found.       [(Maybe Text, Text)]-      -- ^ Not found.+      -- | Out of.       [(Maybe Text, Text)]-      -- ^ Out of.   | NoneOfChildrenFoundByNameElementError+      -- | Not found.       [(Maybe Text, Text)]-      -- ^ Not found.+      -- | Out of.       [(Maybe Text, Text)]-      -- ^ Out of.   | ChildByNameElementError+      -- | Namespace.       (Maybe Text)-      -- ^ Namespace.+      -- | Name.       Text-      -- ^ Name.+      -- | Reason. Not 'NodeError' because only element nodes can be looked up by name.       ElementError-      -- ^ Reason. Not 'NodeError' because only element nodes can be looked up by name.   | ChildAtOffsetElementError+      -- | Offset.       Int-      -- ^ Offset.+      -- | Reason.       NodeError-      -- ^ Reason.   | NameElementError Text   | -- | Error raised by the user of this library.     UserElementError Text  data NodeError   = UnexpectedNodeTypeNodeError+      -- | Expected.       NodeType-      -- ^ Expected.+      -- | Actual.       NodeType-      -- ^ Actual.   | NotAvailableNodeError   | ElementNodeError ElementError   | TextNodeError (Maybe ContentError)@@ -175,10 +177,10 @@   | NamespaceNotFoundContentError Text   | UnexpectedValueContentError Text   | EnumContentError+      -- | List of expected values.       [Text]-      -- ^ List of expected values.+      -- | Actual value       Text-      -- ^ Actual value   | UserContentError Text  data NodeType
library/XmlParser/Attoparsec.hs view
@@ -56,25 +56,30 @@     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'+      or+        [ 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+      or+        [ x == '-',+          x == '.',+          x >= '0' && x <= '9',+          x == '\xB7',+          x >= '\x0300' && x <= '\x036F',+          x >= '\x203F' && x <= '\x2040',+          nameStartCharPredicate x+        ]
library/XmlParser/ElementDestructionState.hs view
@@ -19,10 +19,10 @@ -- You can use this as a parameter to a reader monad. data ElementDestructionContext   = ElementDestructionContext+      -- | Namespace registry as seen from the context of this node.       NamespaceRegistry.NamespaceRegistry-      -- ^ Namespace registry as seen from the context of this node.+      -- | The node that we're in the context of.       Xml.Element-      -- ^ The node that we're in the context of.  -- | -- Used for the state of a parser in the context of specifically element node.@@ -32,10 +32,10 @@ -- You can use this as a parameter to the state monad. data ElementDestructionState   = ElementDestructionState+      -- | Cached attribute by name lookup map.       (Maybe (NameMap.NameMap Text))-      -- ^ Cached attribute by name lookup map.+      -- | Cached child element by name lookup map.       (Maybe (NameMap.NameMap Xml.Element))-      -- ^ Cached child element by name lookup map.  new :: ElementDestructionState new = ElementDestructionState Nothing Nothing
library/XmlParser/NameMap.hs view
@@ -18,10 +18,10 @@  data NameMap a   = NameMap+      -- | Namespaced       (TupleHashMap.TupleHashMap Text Text [a])-      -- ^ Namespaced+      -- | Unnamespaced       (HashMap Text [a])-      -- ^ Unnamespaced  fromNodes :: NamespaceRegistry.NamespaceRegistry -> [Xml.Node] -> NameMap Xml.Element fromNodes nreg =
library/XmlParser/NodeConsumerState.hs view
@@ -15,12 +15,12 @@  data NodeConsumerState   = NodeConsumerState+      -- | Nodes.       [Xml.Node]-      -- ^ Nodes.+      -- | Offset.       Int-      -- ^ Offset.+      -- | Namespace registry.       NamespaceRegistry.NamespaceRegistry-      -- ^ Namespace registry.  new :: [Xml.Node] -> NamespaceRegistry.NamespaceRegistry -> NodeConsumerState new nodes nsReg = NodeConsumerState nodes 0 nsReg
library/XmlParser/Prelude.hs view
@@ -34,7 +34,7 @@ import Data.Fixed as Exports import Data.Foldable as Exports hiding (toList) import Data.Function as Exports hiding (id, (.))-import Data.Functor as Exports+import Data.Functor as Exports hiding (unzip) import Data.Functor.Compose as Exports import Data.Functor.Identity as Exports import Data.HashMap.Strict as Exports (HashMap)@@ -79,12 +79,10 @@ import System.Mem as Exports import System.Mem.StableName as Exports import System.Timeout as Exports-import Text.ParserCombinators.ReadP as Exports (ReadP, readP_to_S, readS_to_P)-import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readP_to_Prec, readPrec_to_P, readPrec_to_S, readS_to_Prec) import Text.Printf as Exports (hPrintf, printf) import Text.Read as Exports (Read (..), readEither, readMaybe) import Unsafe.Coerce as Exports import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.)) -tryMapping :: Exception e => (e -> e') -> IO a -> IO (Either e' a)+tryMapping :: (Exception e) => (e -> e') -> IO a -> IO (Either e' a) tryMapping f action = catch (fmap Right action) (pure . Left . f)
library/XmlParser/XmlConduitWrapper.hs view
@@ -34,11 +34,11 @@ renderError :: SomeException -> Text renderError e   | Just e <- fromException @XmlConduit.XMLException e =-    fromString (show e)+      fromString (show e)   | Just e <- fromException @XmlConduit.InvalidEventStream e =-    fromString (show e)+      fromString (show e)   | Just (XmlConduit.UnresolvedEntityException e) <- fromException @XmlConduit.UnresolvedEntityException e =-    "Unresolved entities: " <> Text.intercalate "," (toList e)+      "Unresolved entities: " <> Text.intercalate "," (toList e)   | otherwise =-    -- FIXME: Find other cases and do something more user-friendly about them-    fromString (show e)+      -- FIXME: Find other cases and do something more user-friendly about them+      fromString (show e)
test/Main.hs view
@@ -11,10 +11,11 @@ import qualified XmlParser as Xp import Prelude hiding (assert) +main :: IO () main =-  defaultMain $-    testGroup "All tests" $-      [ testProperty "ByName/many" $ do+  defaultMain+    $ testGroup "All tests"+    $ [ testProperty "ByName/many" $ do           bContents <- fmap (fromString . show) <$> listOf (chooseInt (0, 99))            xml <-@@ -22,8 +23,9 @@                   Xc.Element name [] . pure . Xc.NodeContent                 root =                   Xc.Element "a" [] . fmap (Xc.NodeElement)-             in fmap (documentByteString . elementDocument . root . join) $-                  forM bContents $ \bContent -> do+             in fmap (documentByteString . elementDocument . root . join)+                  $ forM bContents+                  $ \bContent -> do                     prefix <-                       oneof                         [ pure [],@@ -50,13 +52,13 @@            in assertEqual "" (Right (Just "abc-uri", "d")) (Xp.parseByteString parser input),         testGroup           "Regressions"-          [ testCase "Empty string content parsing" $-              let input = "<Value xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" xmlns:xsd=\"http://www.w3.org/2001/XMLSchema\" xsi:type=\"xsd:string\"></Value>" :: ByteString-                  parser = Xp.children $ Xp.contentNode $ Xp.textContent-               in assertEqual-                    ""-                    (Right "")-                    (Xp.parseByteString parser input)+          [ testCase "Empty string content parsing"+              $ let input = "<Value xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" xmlns:xsd=\"http://www.w3.org/2001/XMLSchema\" xsi:type=\"xsd:string\"></Value>" :: ByteString+                    parser = Xp.children $ Xp.contentNode $ Xp.textContent+                 in assertEqual+                      ""+                      (Right "")+                      (Xp.parseByteString parser input)           ]       ] 
xml-parser.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: xml-parser-version: 0.1.1.1+version: 0.1.1.2 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@@ -9,18 +9,74 @@ copyright: (c) 2021 Nikita Volkov license: MIT license-file: LICENSE-build-type: Simple  source-repository head   type: git-  location: git://github.com/nikita-volkov/xml-parser.git+  location: https://github.com/nikita-volkov/xml-parser +common base+  default-language: Haskell2010+  default-extensions:+    ApplicativeDo+    Arrows+    BangPatterns+    BlockArguments+    ConstraintKinds+    DataKinds+    DefaultSignatures+    DeriveDataTypeable+    DeriveFoldable+    DeriveFunctor+    DeriveGeneric+    DeriveTraversable+    DerivingVia+    EmptyDataDecls+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    GeneralizedNewtypeDeriving+    LambdaCase+    LiberalTypeSynonyms+    MultiParamTypeClasses+    MultiWayIf+    NoImplicitPrelude+    NoMonomorphismRestriction+    OverloadedStrings+    PatternGuards+    QuasiQuotes+    RankNTypes+    RecordWildCards+    RoleAnnotations+    ScopedTypeVariables+    StandaloneDeriving+    StrictData+    TupleSections+    TypeApplications+    TypeFamilies+    TypeOperators++common executable+  import: base+  ghc-options:+    -O2+    -threaded+    -with-rtsopts=-N+    -rtsopts+    -funbox-strict-fields++common test+  import: base+  ghc-options:+    -threaded+    -with-rtsopts=-N+ library+  import: base   hs-source-dirs: library-  default-extensions: BangPatterns, BinaryLiterals, BlockArguments, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, DerivingVia, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, StrictData, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, UnboxedSums, UnboxedTuples, ViewPatterns-  default-language: Haskell2010   exposed-modules:     XmlParser+   other-modules:     XmlParser.AstParser     XmlParser.Attoparsec@@ -28,31 +84,29 @@     XmlParser.NameMap     XmlParser.NamespaceRegistry     XmlParser.NodeConsumerState-    XmlParser.TupleHashMap     XmlParser.Prelude+    XmlParser.TupleHashMap     XmlParser.XmlConduitWrapper+   build-depends:     attoparsec >=0.13 && <0.15,     base >=4.11 && <5,-    bytestring >=0.10 && <0.12,-    containers ^>=0.6,+    bytestring >=0.10 && <0.14,+    containers >=0.6 && <0.9,     hashable >=1.2 && <2,     text >=1.2.4 && <3,-    text-builder >=0.6.6.2 && <0.7,-    transformers ^>=0.5,+    text-builder >=1 && <1.1,+    transformers >=0.5 && <0.8,     unordered-containers ^>=0.2.14,-    xml-conduit ^>=1.9.1.1,+    xml-conduit >=1.9.1.1 && <1.11,  test-suite test+  import: test   type: exitcode-stdio-1.0   hs-source-dirs: test-  default-extensions: BangPatterns, BinaryLiterals, BlockArguments, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, DerivingVia, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, StrictData, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, UnboxedSums, UnboxedTuples, ViewPatterns-  default-language: Haskell2010   main-is: Main.hs   other-modules:   build-depends:-    attoparsec >=0.13 && <0.15,-    QuickCheck >=2.8.1 && <3,     quickcheck-instances >=0.3.11 && <0.4,     rerebase >=1.6.1 && <2,     tasty >=0.12 && <2,