xml-conduit 1.0.3.3 → 1.1.0
raw patch · 5 files changed
+88/−78 lines, 5 filesdep ~attoparsec-conduitdep ~blaze-builder-conduitdep ~conduit
Dependency ranges changed: attoparsec-conduit, blaze-builder-conduit, conduit
Files
- Text/XML.hs +7/−7
- Text/XML/Stream/Parse.hs +50/−39
- Text/XML/Stream/Render.hs +14/−14
- Text/XML/Unresolved.hs +13/−14
- xml-conduit.cabal +4/−4
Text/XML.hs view
@@ -99,7 +99,7 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE-import Data.Conduit hiding (Source, Sink, Conduit)+import Data.Conduit import qualified Data.Conduit.List as CL import qualified Data.Conduit.Binary as CB import System.IO.Unsafe (unsafePerformIO)@@ -232,8 +232,8 @@ sinkDoc :: MonadThrow m => ParseSettings- -> Pipe l ByteString o u m Document-sinkDoc ps = P.parseBytesPos ps >+> fromEvents+ -> Consumer ByteString m Document+sinkDoc ps = P.parseBytesPos ps =$= fromEvents parseText :: ParseSettings -> TL.Text -> Either SomeException Document parseText ps tl = runST@@ -246,10 +246,10 @@ sinkTextDoc :: MonadThrow m => ParseSettings- -> Pipe l Text o u m Document-sinkTextDoc ps = P.parseText ps >+> fromEvents+ -> Consumer Text m Document+sinkTextDoc ps = P.parseText ps =$= fromEvents -fromEvents :: MonadThrow m => Pipe l P.EventPos o u m Document+fromEvents :: MonadThrow m => Consumer P.EventPos m Document fromEvents = do d <- D.fromEvents either (lift . monadThrow . UnresolvedEntityException) return $ fromXMLDocument d@@ -258,7 +258,7 @@ deriving (Show, Typeable) instance Exception UnresolvedEntityException -renderBytes :: MonadUnsafeIO m => R.RenderSettings -> Document -> Pipe l i ByteString u m ()+renderBytes :: MonadUnsafeIO m => R.RenderSettings -> Document -> Producer m ByteString renderBytes rs doc = D.renderBytes rs $ toXMLDocument' rs doc writeFile :: R.RenderSettings -> FilePath -> Document -> IO ()
Text/XML/Stream/Parse.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PatternGuards #-}+{-# LANGUAGE ImpredicativeTypes #-} -- | This module provides both a native Haskell solution for parsing XML -- documents into a stream of events, and a set of parser combinators for -- dealing with a stream of events.@@ -112,7 +113,7 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.Map as Map-import Data.Conduit hiding (Source, Sink, Conduit)+import Data.Conduit import qualified Data.Conduit.Text as CT import qualified Data.Conduit.List as CL import Control.Monad (ap, liftM)@@ -183,11 +184,11 @@ -- first checks for BOMs, removing them as necessary, and then check for the -- equivalent of <?xml for each of UTF-8, UTF-16LE/BE, and UTF-32LE/BE. It -- defaults to assuming UTF-8.-detectUtf :: MonadThrow m => Pipe l S.ByteString TS.Text r m r+detectUtf :: MonadThrow m => Conduit S.ByteString m TS.Text detectUtf =- injectLeftovers $ conduit id+ conduit id where- conduit front = awaitE >>= either return (push front)+ conduit front = await >>= maybe (return ()) (push front) push front bss = case getEncoding front bss of@@ -228,16 +229,18 @@ -- This relies on 'detectUtf' to determine character encoding, and 'parseText' -- to do the actual parsing. parseBytes :: MonadThrow m- => ParseSettings -> Pipe l S.ByteString Event r m r+ => ParseSettings+ -> Conduit S.ByteString m Event parseBytes = mapOutput snd . parseBytesPos parseBytesPos :: MonadThrow m- => ParseSettings -> Pipe l S.ByteString EventPos r m r-parseBytesPos ps = detectUtf >+> parseText ps+ => ParseSettings+ -> Conduit S.ByteString m EventPos+parseBytesPos ps = detectUtf =$= parseText ps -dropBOM :: Monad m => Pipe l TS.Text TS.Text r m r+dropBOM :: Monad m => Conduit TS.Text m TS.Text dropBOM =- awaitE >>= either return push+ await >>= maybe (return ()) push where push t = case T.uncons t of@@ -247,7 +250,7 @@ | c == '\xfeef' = cs | otherwise = t in yield output >> idConduit- idConduit = awaitE >>= either return (\x -> yield x >> idConduit)+ idConduit = await >>= maybe (return ()) (\x -> yield x >> idConduit) -- | Parses a character stream into 'Event's. This function is implemented -- fully in Haskell using attoparsec-text for parsing. The produced error@@ -256,25 +259,25 @@ -- advantage of not relying on any C libraries. parseText :: MonadThrow m => ParseSettings- -> Pipe l TS.Text EventPos r m r+ -> Conduit TS.Text m EventPos parseText de = dropBOM- >+> tokenize- >+> toEventC- >+> addBeginEnd+ =$= tokenize+ =$= toEventC+ =$= addBeginEnd where- tokenize = injectLeftovers $ conduitToken de+ tokenize = conduitToken de addBeginEnd = yield (Nothing, EventBeginDocument) >> addEnd- addEnd = awaitE >>= either- (\u -> yield (Nothing, EventEndDocument) >> return u)+ addEnd = await >>= maybe+ (yield (Nothing, EventEndDocument)) (\e -> yield e >> addEnd) -toEventC :: Monad m => Pipe l (PositionRange, Token) EventPos r m r+toEventC :: Monad m => Conduit (PositionRange, Token) m EventPos toEventC = go [] [] where go es levels =- awaitE >>= either return push+ await >>= maybe (return ()) push where push (position, token) = mapM_ (yield . ((,) (Just position))) events >> go es' levels'@@ -290,7 +293,7 @@ { psDecodeEntities = decodeXmlEntities } -conduitToken :: MonadThrow m => ParseSettings -> Pipe TS.Text TS.Text (PositionRange, Token) r m r+conduitToken :: MonadThrow m => ParseSettings -> Conduit TS.Text m (PositionRange, Token) conduitToken = conduitParser . parseToken . psDecodeEntities parseToken :: DecodeEntities -> Parser Token@@ -467,7 +470,7 @@ -- | Grabs the next piece of content if available. This function skips over any -- comments and instructions and concatenates all content until the next start -- or end tag.-contentMaybe :: MonadThrow m => Pipe Event Event o u m (Maybe Text)+contentMaybe :: MonadThrow m => Consumer Event m (Maybe Text) contentMaybe = do x <- CL.peek case pc' x of@@ -499,7 +502,7 @@ -- | Grabs the next piece of content. If none if available, returns 'T.empty'. -- This is simply a wrapper around 'contentMaybe'.-content :: MonadThrow m => Pipe Event Event o u m Text+content :: MonadThrow m => Consumer Event m Text content = do x <- contentMaybe case x of@@ -518,8 +521,8 @@ tag :: MonadThrow m => (Name -> Maybe a) -> (a -> AttrParser b)- -> (b -> Pipe Event Event o u m c)- -> Pipe Event Event o u m (Maybe c)+ -> (b -> Consumer Event m c)+ -> Consumer Event m (Maybe c) tag checkName attrParser f = do x <- dropWS case x of@@ -568,8 +571,8 @@ tagPredicate :: MonadThrow m => (Name -> Bool) -> AttrParser a- -> (a -> Pipe Event Event o u m b)- -> Pipe Event Event o u m (Maybe b)+ -> (a -> Consumer Event m b)+ -> Consumer Event m (Maybe b) tagPredicate p attrParser = tag (\x -> if p x then Just () else Nothing) (const attrParser) -- | A simplified version of 'tag' which matches for specific tag names instead@@ -579,19 +582,25 @@ tagName :: MonadThrow m => Name -> AttrParser a- -> (a -> Pipe Event Event o u m b)- -> Pipe Event Event o u m (Maybe b)+ -> (a -> Consumer Event m b)+ -> Consumer Event m (Maybe b) tagName name = tagPredicate (== name) -- | A further simplified tag parser, which requires that no attributes exist.-tagNoAttr :: MonadThrow m => Name -> Pipe Event Event o u m a -> Pipe Event Event o u m (Maybe a)+tagNoAttr :: MonadThrow m+ => Name+ -> Consumer Event m a+ -> Consumer Event m (Maybe a) tagNoAttr name f = tagName name (return ()) $ const f -- | Get the value of the first parser which returns 'Just'. If no parsers -- succeed (i.e., return 'Just'), this function returns 'Nothing'. -- -- > orE a b = choose [a, b]-orE :: Monad m => Pipe l Event o u m (Maybe a) -> Pipe l Event o u m (Maybe a) -> Pipe l Event o u m (Maybe a)+orE :: Monad m+ => Consumer Event m (Maybe a)+ -> Consumer Event m (Maybe a)+ -> Consumer Event m (Maybe a) orE a b = do x <- a case x of@@ -601,8 +610,8 @@ -- | Get the value of the first parser which returns 'Just'. If no parsers -- succeed (i.e., return 'Just'), this function returns 'Nothing'. choose :: Monad m- => [Pipe l Event o u m (Maybe a)]- -> Pipe l Event o u m (Maybe a)+ => [Consumer Event m (Maybe a)]+ -> Consumer Event m (Maybe a) choose [] = return Nothing choose (i:is) = do x <- i@@ -615,8 +624,8 @@ -- want to finally force something to happen. force :: MonadThrow m => String -- ^ Error message- -> Pipe l Event o u m (Maybe a)- -> Pipe l Event o u m a+ -> Consumer Event m (Maybe a)+ -> Consumer Event m a force msg i = do x <- i case x of@@ -629,15 +638,15 @@ parseFile :: MonadResource m => ParseSettings -> FilePath- -> Pipe l i Event u m ()-parseFile ps fp = sourceFile (encodeString fp) >+> parseBytes ps+ -> Producer m Event+parseFile ps fp = sourceFile (encodeString fp) =$= parseBytes ps -- | Parse an event stream from a lazy 'L.ByteString'. parseLBS :: MonadThrow m => ParseSettings -> L.ByteString- -> Pipe l i Event u m ()-parseLBS ps lbs = CL.sourceList (L.toChunks lbs) >+> parseBytes ps+ -> Producer m Event+parseLBS ps lbs = CL.sourceList (L.toChunks lbs) =$= parseBytes ps data XmlException = XmlException { xmlErrorMessage :: String@@ -719,7 +728,9 @@ ignoreAttrs = AttrParser $ \_ -> Right ([], ()) -- | Keep parsing elements as long as the parser returns 'Just'.-many :: Monad m => Pipe l Event o u m (Maybe a) -> Pipe l Event o u m [a]+many :: Monad m+ => Consumer Event m (Maybe a)+ -> Consumer Event m [a] many i = go id where
Text/XML/Stream/Render.hs view
@@ -29,7 +29,7 @@ import Data.Default (Default (def)) import qualified Data.Set as Set import Data.List (foldl')-import Data.Conduit hiding (Source, Sink, Conduit)+import Data.Conduit import qualified Data.Conduit.List as CL import qualified Data.Conduit.Text as CT import Data.Monoid (mempty)@@ -39,15 +39,15 @@ -- optimally sized 'ByteString's with minimal buffer copying. -- -- The output is UTF8 encoded.-renderBytes :: MonadUnsafeIO m => RenderSettings -> Pipe l Event ByteString r m r-renderBytes rs = renderBuilder rs >+> builderToByteString+renderBytes :: MonadUnsafeIO m => RenderSettings -> Conduit Event m ByteString+renderBytes rs = renderBuilder rs =$= builderToByteString -- | Render a stream of 'Event's into a stream of 'ByteString's. This function -- wraps around 'renderBuilder', 'builderToByteString' and 'renderBytes', so it -- produces optimally sized 'ByteString's with minimal buffer copying. renderText :: (MonadThrow m, MonadUnsafeIO m)- => RenderSettings -> Pipe l Event Text r m r-renderText rs = renderBytes rs >+> CT.decode CT.utf8+ => RenderSettings -> Conduit Event m Text+renderText rs = renderBytes rs =$= CT.decode CT.utf8 data RenderSettings = RenderSettings { rsPretty :: Bool@@ -92,15 +92,15 @@ -- | Render a stream of 'Event's into a stream of 'Builder's. Builders are from -- the blaze-builder package, and allow the create of optimally sized -- 'ByteString's with minimal buffer copying.-renderBuilder :: Monad m => RenderSettings -> Pipe l Event Builder r m r-renderBuilder RenderSettings { rsPretty = True, rsNamespaces = n } = prettify >+> renderBuilder' n True+renderBuilder :: Monad m => RenderSettings -> Conduit Event m Builder+renderBuilder RenderSettings { rsPretty = True, rsNamespaces = n } = prettify =$= renderBuilder' n True renderBuilder RenderSettings { rsPretty = False, rsNamespaces = n } = renderBuilder' n False -renderBuilder' :: Monad m => [(Text, Text)] -> Bool -> Pipe l Event Builder r m r+renderBuilder' :: Monad m => [(Text, Text)] -> Bool -> Conduit Event m Builder renderBuilder' namespaces0 isPretty = do- injectLeftovers $ loop []+ loop [] where- loop nslevels = awaitE >>= either return (go nslevels)+ loop nslevels = await >>= maybe (return ()) (go nslevels) go nslevels e = case e of@@ -233,12 +233,12 @@ -- | Convert a stream of 'Event's into a prettified one, adding extra -- whitespace. Note that this can change the meaning of your XML.-prettify :: Monad m => Pipe l Event Event r m r-prettify = injectLeftovers $ prettify' 0+prettify :: Monad m => Conduit Event m Event+prettify = prettify' 0 -prettify' :: Monad m => Int -> Pipe Event Event Event r m r+prettify' :: Monad m => Int -> Conduit Event m Event prettify' level =- awaitE >>= either return go+ await >>= maybe (return ()) go where go e@EventBeginDocument = do yield e
Text/XML/Unresolved.hs view
@@ -57,12 +57,11 @@ import Data.Char (isSpace) import qualified Data.ByteString.Lazy as L import System.IO.Unsafe (unsafePerformIO)-import Data.Conduit hiding (Source, Sink, Conduit)+import Data.Conduit import qualified Data.Conduit.List as CL import qualified Data.Conduit.Binary as CB import Control.Exception (throw) import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Resource (runExceptionT) import Control.Monad.ST (runST) import Data.Conduit.Lazy (lazyConsume) @@ -71,8 +70,8 @@ sinkDoc :: MonadThrow m => P.ParseSettings- -> Pipe l ByteString o u m Document-sinkDoc ps = P.parseBytesPos ps >+> fromEvents+ -> Consumer ByteString m Document+sinkDoc ps = P.parseBytesPos ps =$= fromEvents writeFile :: R.RenderSettings -> FilePath -> Document -> IO () writeFile rs fp doc =@@ -120,17 +119,17 @@ prettyShowName :: Name -> String prettyShowName = show -- FIXME -renderBuilder :: Monad m => R.RenderSettings -> Document -> Pipe l i Builder u m ()-renderBuilder rs doc = CL.sourceList (toEvents doc) >+> R.renderBuilder rs+renderBuilder :: Monad m => R.RenderSettings -> Document -> Producer m Builder+renderBuilder rs doc = CL.sourceList (toEvents doc) =$= R.renderBuilder rs -renderBytes :: MonadUnsafeIO m => R.RenderSettings -> Document -> Pipe l i ByteString u m ()-renderBytes rs doc = CL.sourceList (toEvents doc) >+> R.renderBytes rs+renderBytes :: MonadUnsafeIO m => R.RenderSettings -> Document -> Producer m ByteString+renderBytes rs doc = CL.sourceList (toEvents doc) =$= R.renderBytes rs -renderText :: (MonadThrow m, MonadUnsafeIO m) => R.RenderSettings -> Document -> Pipe l i Text u m ()-renderText rs doc = CL.sourceList (toEvents doc) >+> R.renderText rs+renderText :: (MonadThrow m, MonadUnsafeIO m) => R.RenderSettings -> Document -> Producer m Text+renderText rs doc = CL.sourceList (toEvents doc) =$= R.renderText rs -fromEvents :: MonadThrow m => Pipe l P.EventPos o u m Document-fromEvents = injectLeftovers $ do+fromEvents :: MonadThrow m => Consumer P.EventPos m Document+fromEvents = do skip EventBeginDocument d <- Document <$> goP <*> require goE <*> goM skip EventEndDocument@@ -259,5 +258,5 @@ sinkTextDoc :: MonadThrow m => ParseSettings- -> Pipe l Text o u m Document-sinkTextDoc ps = P.parseText ps >+> fromEvents+ -> Consumer Text m Document+sinkTextDoc ps = P.parseText ps =$= fromEvents
xml-conduit.cabal view
@@ -1,5 +1,5 @@ name: xml-conduit-version: 1.0.3.3+version: 1.1.0 license: BSD3 license-file: LICENSE author: Michael Snoyman <michaels@suite-sol.com>, Aristid Breitkreuz <aristidb@googlemail.com>@@ -28,10 +28,10 @@ library build-depends: base >= 4 && < 5- , conduit >= 0.5 && < 0.6+ , conduit >= 1.0 && < 1.1 , resourcet >= 0.3 && < 0.5- , attoparsec-conduit >= 0.5 && < 0.6- , blaze-builder-conduit >= 0.5 && < 0.6+ , attoparsec-conduit >= 1.0+ , blaze-builder-conduit >= 1.0 , bytestring >= 0.9 , text >= 0.7 && < 0.12 , containers >= 0.2