hextream 0.1.0.1 → 0.2.0.0

raw patch · 5 files changed

+48/−24 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +4/−0
• hextream.cabal +1/−1
• src/Data/XML/Parser/High.hs +3/−3
• src/Data/XML/Parser/High/AttrParser.hs +17/−10
• src/Data/XML/Parser/High/NameParser.hs +23/−10

@@ -6,6 +6,10 @@  The library does not define a data type nor parser for a whole XML document. Instead, parsers operate on XML tokens of various sizes, to allow for a usage in a streaming context (e.g. using [`streaming-attoparsec`](https://hackage.haskell.org/package/streaming-attoparsec)). +The implementation is based on the following specifications:+- [Extensible Markup Language (XML) 1.0 (Fifth Edition)](https://www.w3.org/TR/REC-xml/)+- [Namespaces in XML 1.0 (Third Edition)](https://www.w3.org/TR/xml-names/)+  ## Caveats 

@@ -1,7 +1,7 @@ cabal-version:       2.4  name:                hextream-version:             0.1.0.1+version:             0.2.0.0 synopsis:            Streaming-friendly XML parsers description:         Cf README file homepage:            https://github.com/k0ral/hextream

@@ -222,9 +222,9 @@       AnyContent f       -> f mempty       WithContent parser -> unexpected "Expected non-empty tag"   processName name = runNameParser parseName name-    & maybe (unexpected "Unexpected name") return+    & either unexpected return   processAttributes state attributes = runAttrParser (parseAttributes state) (normalizeAttributes entityDecoder attributes)-    & maybe (unexpected "Unexpected attributes") return+    & either unexpected return  -- | Simplified version of 'tag': --@@ -259,7 +259,7 @@   <|> (TokenTextContent <$> textContent entityDecoder)   where tokenTag = tag entityDecoder anyName (\name -> (name,) <$> forwardAttrs) $ \(name, attributes) ->           TokenTag name attributes <$> AnyContent pure-        forwardAttrs = AttrParser Just+        forwardAttrs = AttrParser Right  -- | Same as @anyToken (decodePredefinedEntities <> decodeHtmlEntities)@, provided for convenience. anyToken' :: CharParsing m => Monad m => TokenParser m Token

@@ -2,6 +2,7 @@ {-# LANGUAGE DerivingVia                #-} {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoImplicitPrelude          #-} {-# LANGUAGE StandaloneDeriving         #-} -- | All documentation examples assume the following setup: --@@ -18,11 +19,14 @@  import           Control.Applicative import           Control.Arrow-import           Control.Monad-import           Data.Map                 (Map)-import qualified Data.Map                 as Map-import           Data.Text                (Text)+import           Control.Monad.Compat+import           Control.Monad.Fail.Compat+import           Data.Map                  (Map)+import qualified Data.Map                  as Map+import           Data.Text                 (Text)+import qualified Data.Text                 as Text import           Data.XML.Parser.Low.Name+import           Prelude.Compat  -- $setup -- >>> :set -XOverloadedStrings@@ -30,13 +34,13 @@ -- >>> import Data.XML.Parser.High  -- | How to parse tag attributes.-newtype AttrParser a = AttrParser { runAttrParser :: Map QName Text -> Maybe a }+newtype AttrParser a = AttrParser { runAttrParser :: Map QName Text -> Either String a }  deriving instance Functor AttrParser-deriving via (WrappedArrow (Kleisli Maybe) (Map QName Text)) instance Applicative AttrParser+deriving via (WrappedArrow (Kleisli (Either String)) (Map QName Text)) instance Applicative AttrParser  -- | Can be combined with @\<|\>@-deriving via (WrappedArrow (Kleisli Maybe) (Map QName Text)) instance Alternative AttrParser+deriving via (WrappedArrow (Kleisli (Either String)) (Map QName Text)) instance Alternative AttrParser  -- | Can be combined with @>>=@. Attributes map is forwarded without change. instance Monad AttrParser where@@ -45,6 +49,9 @@     let AttrParser g' = g a     g' attributes +instance MonadFail AttrParser where+  fail message = AttrParser $ const $ Left message+ -- | Parse any set of attributes. -- -- >>> parseOnly (runTokenParser $ tag' anyName anyAttr noContent) "<tag></tag>"@@ -61,7 +68,7 @@ -- >>> parseOnly (runTokenParser $ tag' anyName noAttr noContent) "<tag key='value'></tag>" -- Left ... noAttr :: AttrParser ()-noAttr = AttrParser $ \attributes -> if null attributes then Just () else Nothing+noAttr = AttrParser $ \attributes -> if null attributes then Right () else Left $ "Expected no attribute, instead got: " <> show attributes  -- | Parse attribute by name, and return its value. --@@ -70,7 +77,7 @@ -- >>> parseOnly (runTokenParser $ tag' anyName (attrValue "foo") noContent) "<tag foo='bar'></tag>" -- Right () attrValue :: QName -> AttrParser Text-attrValue name = AttrParser $ Map.lookup name+attrValue name = AttrParser $ maybe (Left $ "Missing attribute named " <> show name) Right . Map.lookup name  -- | Assert that an attribute exists, with given name and value. --@@ -81,4 +88,4 @@ -- >>> parseOnly (runTokenParser $ tag' anyName (hasAttr "foo" "bar") noContent) "<tag foo='bar'></tag>" -- Right () hasAttr :: QName -> Text -> AttrParser ()-hasAttr name value = attrValue name >>= \value' -> guard (value == value')+hasAttr name value = attrValue name >>= \value' -> if value == value' then pure () else fail $ "Expected attribute value " <> Text.unpack value <> ", instead got: " <> Text.unpack value'

@@ -2,6 +2,7 @@ {-# LANGUAGE DerivingVia                #-} {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoImplicitPrelude          #-} {-# LANGUAGE StandaloneDeriving         #-} {-# LANGUAGE TypeFamilies               #-} -- | All documentation examples assume the following setup:@@ -17,9 +18,11 @@  import           Control.Applicative import           Control.Arrow-import           Control.Monad+import           Control.Monad.Compat+import           Control.Monad.Fail.Compat import           Data.String import           Data.XML.Parser.Low+import           Prelude.Compat  -- $setup -- >>> :set -XOverloadedStrings@@ -27,25 +30,35 @@ -- >>> import Data.XML.Parser.High  -- | How to parse tag names.-newtype NameParser a = NameParser { runNameParser :: QName -> Maybe a }+newtype NameParser a = NameParser { runNameParser :: QName -> Either String a }  deriving instance Functor NameParser-deriving via (WrappedArrow (Kleisli Maybe) QName) instance Applicative NameParser+deriving via (WrappedArrow (Kleisli (Either String)) QName) instance Applicative NameParser  -- | Can be combined with @\<|\>@-deriving via (WrappedArrow (Kleisli Maybe) QName) instance Alternative NameParser+deriving via (WrappedArrow (Kleisli (Either String)) QName) instance Alternative NameParser  -- | Match a single 'QName' in a concise way. -- -- >>> parseOnly (runTokenParser $ tag' "foo" anyAttr anyContent) "<foo></foo>" -- Right () instance (a ~ ()) => IsString (NameParser a) where-  fromString s = NameParser $ \(QName _ name) ->-    unless (fromString s == name) mempty+  fromString s = anyName >>= \(QName _ name) ->+    when (fromString s /= name) $ fail $ "Expected tag named " <> show s <> ", instead got: " <> show name +-- | Can be combined with @>>=@. Qualified name is forwarded without change.+instance Monad NameParser where+  (NameParser f) >>= g = NameParser $ \name -> do+    a <- f name+    let NameParser g' = g a+    g' name++instance MonadFail NameParser where+  fail message = NameParser $ const $ Left message+ -- | Match any qualified name. anyName :: NameParser QName-anyName = NameParser Just+anyName = NameParser Right  -- | Match any qualified name, except for the given value. --@@ -54,6 +67,6 @@ -- >>> parseOnly (runTokenParser $ tag' (anyNameExcept "foo") anyAttr anyContent) "<bar></bar>" -- Right () anyNameExcept :: QName -> NameParser QName-anyNameExcept name = NameParser $ \name' -> do-  guard $ name /= name'-  return name'+anyNameExcept name = NameParser $ \name' -> if name == name'+  then Left $ "Expected any tag name except " <> show name+  else Right name'