xml-conduit 1.7.1.1 → 1.7.1.2

raw patch · 4 files changed

+67/−94 lines, 4 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Text/XML/Stream/Parse.hs +34/−56
• Text/XML/Stream/Render.hs +10/−10
• Text/XML/Stream/Token.hs +22/−27
• xml-conduit.cabal +1/−1

@@ -159,9 +159,8 @@     , PositionRange     , EventPos     ) where-import           Control.Applicative          (Alternative ((<|>)),-                                               Applicative (..), optional,-                                               (<$>))+import           Control.Applicative          (Alternative (empty, (<|>)),+                                               Applicative (..), (<$>)) import qualified Control.Applicative          as A import           Control.Arrow                ((***)) import           Control.Exception            (Exception (..), SomeException)@@ -390,12 +389,17 @@ parseTextPos :: MonadThrow m           => ParseSettings           -> Conduit T.Text m EventPos-parseTextPos de = dropBOM =$= tokenize =$= toEventC de =$= addBeginEnd where-  tokenize = conduitToken de-  addBeginEnd = yield (Nothing, EventBeginDocument) >> addEnd-  addEnd = await >>= maybe-    (yield (Nothing, EventEndDocument))-    (\e -> yield e >> addEnd)+parseTextPos de =+    dropBOM+        =$= tokenize+        =$= toEventC de+        =$= addBeginEnd+  where+    tokenize = conduitToken de+    addBeginEnd = yield (Nothing, EventBeginDocument) >> addEnd+    addEnd = await >>= maybe+        (yield (Nothing, EventEndDocument))+        (\e -> yield e >> addEnd)  toEventC :: Monad m => ParseSettings -> Conduit (PositionRange, Token) m EventPos toEventC ps =@@ -461,7 +465,7 @@                 skipSpace                 char' '?'                 char' '>'-                optional newline+                newline <|> return ()                 return $ TokenXMLDeclaration as             else do                 skipSpace@@ -867,7 +871,7 @@       => String -- ^ Error message       -> m (Maybe a) -- ^ Optional parser to be forced       -> m a-force msg i = i >>= maybe (throwM $ XmlException msg) return+force msg i = i >>= maybe (throwM $ XmlException msg Nothing) return  -- | A helper function which reads a file from disk using 'enumFile', detects -- character encoding using 'detectUtf', parses the XML using 'parseBytes', and@@ -885,37 +889,10 @@          -> Producer m Event parseLBS ps lbs = CL.sourceList (L.toChunks lbs) =$= parseBytes ps --prettyEvent :: Event -> String-prettyEvent EventBeginDocument = "<?xml version=\"SOME_VERSION\" encoding=\"SOME_ENCODING\""-prettyEvent EventEndDocument	 = "?>"-prettyEvent (EventBeginDoctype t externalID) = "<!DOCTYPE " ++ T.unpack t ++ " " ++ maybe mempty prettyExternalID externalID ++ ">"-prettyEvent EventEndDoctype = ">"-prettyEvent (EventInstruction (Instruction target data_)) = "<?" ++ T.unpack target ++ " " ++ T.unpack data_ ++ "?>"-prettyEvent (EventBeginElement name attributes) = "<" ++ prettyName name ++ " " ++ prettyAttributes attributes ++ ">"-prettyEvent (EventEndElement name) = "</" ++ prettyName name ++ ">"-prettyEvent (EventContent content) = prettyContent content-prettyEvent (EventComment t) = "<!-- " ++ T.unpack t ++ " -->"-prettyEvent (EventCDATA t) = "<![CDATA[" ++ T.unpack t ++ "]]>"--prettyAttributes :: [(Name, [Content])] -> String-prettyAttributes = intercalate " " . map (uncurry prettyAttribute)--prettyAttribute :: Name -> [Content] -> String-prettyAttribute name content = prettyName name ++ "=\"" ++ concatMap prettyContent content ++ "\""--prettyExternalID :: ExternalID -> String-prettyExternalID (SystemID location) = "SYSTEM \"" ++ T.unpack location ++ "\""-prettyExternalID (PublicID name location) = "PUBLIC \"" ++ T.unpack name ++ "\" \"" ++ T.unpack location ++ "\""--prettyContent :: Content -> String-prettyContent (ContentText t)   = T.unpack t-prettyContent (ContentEntity t) = T.unpack t--prettyName :: Name -> String-prettyName (Name name _namespace _prefix) = T.unpack name--data XmlException = XmlException String+data XmlException = XmlException+    { xmlErrorMessage :: String+    , xmlBadInput     :: Maybe Event+    }                   | InvalidEndElement Name (Maybe Event)                   | InvalidEntity String (Maybe Event)                   | MissingAttribute String@@ -924,10 +901,11 @@  instance Exception XmlException where #if MIN_VERSION_base(4, 8, 0)-  displayException (XmlException msg) = "Error while parsing XML: " ++ msg-  displayException (InvalidEndElement name (Just event)) = "Error while parsing XML event: expected </" ++ T.unpack (nameLocalName name) ++ ">, got " ++ prettyEvent event+  displayException (XmlException msg (Just event)) = "Error while parsing XML event " ++ show event ++ ": " ++ msg+  displayException (XmlException msg _) = "Error while parsing XML: " ++ msg+  displayException (InvalidEndElement name (Just event)) = "Error while parsing XML event: expected </" ++ T.unpack (nameLocalName name) ++ ">, got " ++ show event   displayException (InvalidEndElement name _) = "Error while parsing XML event: expected </" ++ show name ++ ">, got nothing"-  displayException (InvalidEntity msg (Just event)) = "Error while parsing XML entity " ++ prettyEvent event ++ ": " ++ msg+  displayException (InvalidEntity msg (Just event)) = "Error while parsing XML entity " ++ show event ++ ": " ++ msg   displayException (InvalidEntity msg _) = "Error while parsing XML entity: " ++ msg   displayException (MissingAttribute msg) = "Missing required attribute: " ++ msg   displayException (UnparsedAttributes attrs) = show (length attrs) ++ " remaining unparsed attributes: \n" ++ intercalate "\n" (show <$> attrs)@@ -995,7 +973,7 @@     pure = return     (<*>) = ap instance Alternative AttrParser where-    empty = AttrParser $ const $ Left $ toException $ XmlException "AttrParser.empty"+    empty = AttrParser $ const $ Left $ toException $ XmlException "AttrParser.empty" Nothing     AttrParser f <|> AttrParser g = AttrParser $ \x ->         either (const $ g x) Right (f x) instance MonadThrow AttrParser where@@ -1043,24 +1021,24 @@  -- | Keep parsing elements as long as the parser returns 'Just'. many :: Monad m-     => ConduitM i o m (Maybe a)-     -> ConduitM i o m [a]+     => ConduitM Event o m (Maybe a)+     -> ConduitM Event o m [a] many i = manyIgnore i $ return Nothing  -- | Like 'many' but discards the results without building an intermediate list. -- -- Since 1.5.0 many_ :: MonadThrow m-      => ConduitM i o m (Maybe a)-      -> ConduitM i o m ()+      => ConduitM Event o m (Maybe a)+      -> ConduitM Event o m () many_ consumer = manyIgnoreYield (return Nothing) (void <$> consumer)  -- | Keep parsing elements as long as the parser returns 'Just' --   or the ignore parser returns 'Just'. manyIgnore :: Monad m-           => ConduitM i o m (Maybe a)-           -> ConduitM i o m (Maybe b)-           -> ConduitM i o m [a]+           => ConduitM Event o m (Maybe a)+           -> ConduitM Event o m (Maybe b)+           -> ConduitM Event o m [a] manyIgnore i ignored = go id where   go front = i >>= maybe (onFail front) (\y -> go $ front . (:) y)   -- onFail is called if the main parser fails@@ -1085,9 +1063,9 @@ -- | Like 'manyIgnore', but uses 'yield' so the result list can be streamed --   to downstream conduits without waiting for 'manyIgnoreYield' to finish manyIgnoreYield :: MonadThrow m-                => ConduitM i b m (Maybe b) -- ^ Consuming parser that generates the result stream-                -> ConduitM i b m (Maybe ()) -- ^ Ignore parser that consumes elements to be ignored-                -> Conduit i m b+                => ConduitM Event b m (Maybe b) -- ^ Consuming parser that generates the result stream+                -> ConduitM Event b m (Maybe ()) -- ^ Ignore parser that consumes elements to be ignored+                -> Conduit Event m b manyIgnoreYield consumer ignoreParser = fix $ \loop ->   consumer >>= maybe (onFail loop) (\x -> yield x >> loop)   where onFail loop = ignoreParser >>= maybe (return ()) (const loop)

@@ -69,16 +69,16 @@ renderText rs = renderBytes rs =$= CT.decode CT.utf8  data RenderSettings = RenderSettings-    { rsPretty         :: Bool-    , rsNamespaces     :: [(Text, Text)]+    { rsPretty     :: Bool+    , rsNamespaces :: [(Text, Text)]       -- ^ Defines some top level namespace definitions to be used, in the form       -- of (prefix, namespace). This has absolutely no impact on the meaning       -- of your documents, but can increase readability by moving commonly       -- used namespace declarations to the top level.-    , rsAttrOrder      :: Name -> Map.Map Name Text -> [(Name, Text)]+    , rsAttrOrder  :: Name -> Map.Map Name Text -> [(Name, Text)]       -- ^ Specify how to turn the unordered attributes used by the "Text.XML"       -- module into an ordered list.-    , rsUseCDATA       :: Content -> Bool+    , rsUseCDATA   :: Content -> Bool       -- ^ Determines if for a given text content the renderer should use a       -- CDATA node.       --@@ -129,7 +129,7 @@ renderBuilder :: Monad m => RenderSettings -> Conduit Event m Builder renderBuilder settings = CL.map Chunk =$= renderBuilder' yield' settings   where-    yield' Flush      = return ()+    yield' Flush = return ()     yield' (Chunk bs) = yield bs  -- | Same as 'renderBuilder' but allows you to flush XML stream to ensure that all@@ -192,7 +192,7 @@ eventToToken s useCDATA _ (EventContent c)     | useCDATA c =         case c of-          ContentText txt   -> (tokenToBuilder $ TokenCDATA txt, s)+          ContentText txt -> (tokenToBuilder $ TokenCDATA txt, s)           ContentEntity txt -> (tokenToBuilder $ TokenCDATA txt, s)     | otherwise  = (tokenToBuilder $ TokenContent c, s) eventToToken s _ _ (EventComment t) = (tokenToBuilder $ TokenComment t, s)@@ -208,7 +208,7 @@     | def' == Just ns = TName Nothing name     | otherwise =         case Map.lookup ns sl of-            Nothing   -> error "nameToTName"+            Nothing -> error "nameToTName"             Just pref -> TName (Just pref) name  mkBeginToken :: Bool -- ^ pretty print attributes?@@ -224,7 +224,7 @@   where     indent = if isPretty then 2 + 4 * length s else 0     prevsl = case s of-                []    -> NSLevel Nothing Map.empty+                [] -> NSLevel Nothing Map.empty                 sl':_ -> sl'     (sl1, tname, tattrs1) = newElemStack prevsl name     (sl2, tattrs2) = foldr newAttrStack (sl1, tattrs1) $ nubAttrs attrs@@ -236,7 +236,7 @@     (namespaceSL, namespaceAttrs) = unzip $ mapMaybe unused namespaces0     unused (k, v) =         case lookup k' tattrs2 of-            Just{}  -> Nothing+            Just{} -> Nothing             Nothing -> Just ((v, k), (k', v'))       where         k' = TName (Just "xmlns") k@@ -300,7 +300,7 @@   where     yield' = yield . Chunk -    goC Flush     = yield Flush >> prettify' level+    goC Flush = yield Flush >> prettify' level     goC (Chunk e) = go e      go e@EventBeginDocument = do

@@ -1,5 +1,5 @@-{-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-} module Text.XML.Stream.Token     ( tokenToBuilder     , TName (..)@@ -8,26 +8,21 @@     , NSLevel (..)     ) where -import           Blaze.ByteString.Builder                (Builder,-                                                          copyByteString,-                                                          fromByteString,-                                                          writeByteString)-import           Blaze.ByteString.Builder.Char.Utf8      (fromText, writeChar)-import qualified Blaze.ByteString.Builder.Char8          as BC8-import           Blaze.ByteString.Builder.Internal.Write (fromWriteList)-import           Control.Arrow                           (first)-import           Data.ByteString.Char8                   ()-import           Data.List                               (foldl')-import           Data.Map                                (Map)-import           Data.Monoid                             (mappend, mconcat,-                                                          mempty)-import qualified Data.Set                                as Set-import           Data.String                             (IsString (fromString))-import           Data.Text                               (Text)-import qualified Data.Text                               as T-import           Data.XML.Types                          (Content (..),-                                                          ExternalID (..),-                                                          Instruction (..))+import Data.XML.Types (Instruction (..), Content (..), ExternalID (..))+import qualified Data.Text as T+import Data.Text (Text)+import Data.String (IsString (fromString))+import Blaze.ByteString.Builder+    (Builder, fromByteString, writeByteString, copyByteString)+import Blaze.ByteString.Builder.Internal.Write (fromWriteList)+import Blaze.ByteString.Builder.Char.Utf8 (writeChar, fromText)+import Data.Monoid (mconcat, mempty, mappend)+import Data.ByteString.Char8 ()+import Data.Map (Map)+import qualified Blaze.ByteString.Builder.Char8 as BC8+import qualified Data.Set as Set+import Data.List (foldl')+import Control.Arrow (first)  oneSpace :: Builder oneSpace = copyByteString " "@@ -63,17 +58,17 @@         (if isEmpty then fromByteString "/>" else fromByteString ">")   where     attrs = nubAttrs $ map (first splitTName) attrs'-    lessThan3 []     = True-    lessThan3 [_]    = True+    lessThan3 [] = True+    lessThan3 [_] = True     lessThan3 [_, _] = True-    lessThan3 _      = False+    lessThan3 _ = False tokenToBuilder (TokenEndElement name) = mconcat     [ fromByteString "</"     , tnameToText name     , fromByteString ">"     ] tokenToBuilder (TokenContent c) = contentToText c-tokenToBuilder (TokenCDATA t) =+tokenToBuilder (TokenCDATA t) =      copyByteString "<![CDATA["     `mappend` escCDATA t     `mappend` copyByteString "]]>"@@ -156,7 +151,7 @@  data NSLevel = NSLevel     { defaultNS :: Maybe Text-    , prefixes  :: Map Text Text+    , prefixes :: Map Text Text     }     deriving Show @@ -176,6 +171,6 @@     | otherwise = TName (Just a) $ T.drop 1 b   where     (a, b) = T.break (== ':') t-+     escCDATA :: Text -> Builder escCDATA s = fromText (T.replace "]]>" "]]]]><![CDATA[>" s)

@@ -1,5 +1,5 @@ name:            xml-conduit-version:         1.7.1.1+version:         1.7.1.2 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>, Aristid Breitkreuz <aristidb@googlemail.com>