xml-conduit 0.5.4 → 0.6.0
raw patch · 6 files changed
+64/−86 lines, 6 filesdep +resourcetdep ~attoparsec-conduitdep ~blaze-builder-conduitdep ~conduit
Dependencies added: resourcet
Dependency ranges changed: attoparsec-conduit, blaze-builder-conduit, conduit
Files
- Text/XML.hs +8/−11
- Text/XML/Stream/Parse.hs +32/−34
- Text/XML/Stream/Render.hs +7/−7
- Text/XML/Stream/Token.hs +0/−16
- Text/XML/Unresolved.hs +12/−14
- xml-conduit.cabal +5/−4
Text/XML.hs view
@@ -97,9 +97,9 @@ import qualified Data.Conduit.Binary as CB import System.IO.Unsafe (unsafePerformIO) import Control.Exception (throw)-import Control.Monad.Trans.Resource (ResourceUnsafeIO, runExceptionT)+import Control.Monad.Trans.Resource (MonadUnsafeIO, runExceptionT) import Control.Monad.Trans.Class (lift)-import Text.XML.Stream.Token (lazyConsumeNoResource)+import Data.Conduit.Lazy (lazyConsume) data Document = Document { documentPrologue :: Prologue@@ -198,14 +198,13 @@ parseLBS :: ParseSettings -> L.ByteString -> Either SomeException Document parseLBS ps lbs = runST $ runExceptionT- $ C.runResourceT $ CL.sourceList (L.toChunks lbs) C.$$ sinkDoc ps parseLBS_ :: ParseSettings -> L.ByteString -> Document parseLBS_ ps = either throw id . parseLBS ps -sinkDoc :: C.ResourceThrow m+sinkDoc :: C.MonadThrow m => ParseSettings -> C.Sink ByteString m Document sinkDoc ps = P.parseBytes ps C.=$ fromEvents@@ -213,28 +212,27 @@ parseText :: ParseSettings -> TL.Text -> Either SomeException Document parseText ps tl = runST $ runExceptionT- $ C.runResourceT $ CL.sourceList (TL.toChunks tl) C.$$ sinkTextDoc ps parseText_ :: ParseSettings -> TL.Text -> Document parseText_ ps = either throw id . parseText ps -sinkTextDoc :: C.ResourceThrow m+sinkTextDoc :: C.MonadThrow m => ParseSettings -> C.Sink Text m Document sinkTextDoc ps = P.parseText ps C.=$ fromEvents -fromEvents :: C.ResourceThrow m => C.Sink X.Event m Document+fromEvents :: C.MonadThrow m => C.Sink X.Event m Document fromEvents = do d <- D.fromEvents- either (lift . C.resourceThrow . UnresolvedEntityException) return $ fromXMLDocument d+ either (lift . C.monadThrow . UnresolvedEntityException) return $ fromXMLDocument d data UnresolvedEntityException = UnresolvedEntityException (Set Text) deriving (Show, Typeable) instance Exception UnresolvedEntityException -renderBytes :: ResourceUnsafeIO m => R.RenderSettings -> Document -> C.Source m ByteString+renderBytes :: MonadUnsafeIO m => R.RenderSettings -> Document -> C.Source m ByteString renderBytes rs doc = D.renderBytes rs $ toXMLDocument doc writeFile :: R.RenderSettings -> FilePath -> Document -> IO ()@@ -247,8 +245,7 @@ -- not generally safe, but we know that runResourceT -- will not deallocate any of the resources being used -- by the process- $ C.runResourceT- $ lazyConsumeNoResource+ $ lazyConsume $ renderBytes rs doc renderText :: R.RenderSettings -> Document -> TL.Text
Text/XML/Stream/Parse.hs view
@@ -119,7 +119,7 @@ import Data.Char (isSpace) import Data.Default (Default (..)) import Data.Maybe (catMaybes)-import Control.Monad.Trans.Resource (ResourceIO, resourceThrow)+import Control.Monad.Trans.Resource (MonadResource, monadThrow) import Control.Monad.Trans.Class (lift) type Ents = [(Text, Text)]@@ -180,26 +180,24 @@ -- 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 :: C.ResourceThrow m => C.Conduit S.ByteString m TS.Text+detectUtf :: C.MonadThrow m => C.Conduit S.ByteString m TS.Text detectUtf = conduit id where- conduit front = C.Conduit (push front) close-- push front bss = do- e <- getEncoding front bss- case e of- Left x -> return $ C.Producing (conduit x) []- Right (bss', decode) -> C.conduitPush decode bss'+ conduit front = C.NeedInput (push front) C.Closed - close = return []+ push front bss =+ case getEncoding front bss of+ Left x -> conduit x+ Right (bss', C.NeedInput decode _) -> decode bss'+ Right _ -> error "detectUtf: Unexpecting decode constructor" getEncoding front bs' | S.length bs < 4 =- return $ Left (bs `S.append`)+ Left (bs `S.append`) | otherwise = do let decode = CT.decode codec- return $ Right (bsOut, decode)+ in Right (bsOut, decode) where bs = front bs' bsOut = S.append (S.drop toDrop x) y@@ -225,11 +223,11 @@ -- -- This relies on 'detectUtf' to determine character encoding, and 'parseText' -- to do the actual parsing.-parseBytes :: C.ResourceThrow m+parseBytes :: C.MonadThrow m => ParseSettings -> C.Conduit S.ByteString m Event parseBytes ps = detectUtf C.=$= parseText ps -dropBOM :: C.Resource m => C.Conduit TS.Text m TS.Text+dropBOM :: Monad m => C.Conduit TS.Text m TS.Text dropBOM = C.conduitState False push@@ -251,7 +249,7 @@ -- messages do not give line/column information, so you may prefer to stick -- with the parser provided by libxml-enumerator. However, this has the -- advantage of not relying on any C libraries.-parseText :: C.ResourceThrow m+parseText :: C.MonadThrow m => ParseSettings -> C.Conduit TS.Text m Event parseText de =@@ -272,7 +270,7 @@ push x es = return $ C.StateProducing True $ go x es close x = return $ go x EventEndDocument -toEventC :: C.Resource m => C.Conduit (Maybe Token) m Event+toEventC :: Monad m => C.Conduit (Maybe Token) m Event toEventC = C.conduitState ([], []) push@@ -302,7 +300,7 @@ { psDecodeEntities = decodeXmlEntities } -sinkToken :: C.ResourceThrow m => ParseSettings -> C.Sink TS.Text m (Maybe Token)+sinkToken :: C.MonadThrow m => ParseSettings -> C.Sink TS.Text m (Maybe Token) sinkToken de = sinkParser ((endOfInput >> return Nothing) <|> fmap Just (parseToken $ psDecodeEntities de)) parseToken :: DecodeEntities -> Parser Token@@ -475,13 +473,13 @@ -- | 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 :: C.ResourceThrow m => C.Sink Event m (Maybe Text)+contentMaybe :: C.MonadThrow m => C.Sink Event m (Maybe Text) contentMaybe = do x <- CL.peek case pc' x of Ignore -> CL.drop 1 >> contentMaybe IsContent t -> CL.drop 1 >> fmap Just (takeContents (t:))- IsError e -> lift $ C.resourceThrow $ XmlException e x+ IsError e -> lift $ C.monadThrow $ XmlException e x NotContent -> return Nothing where pc' Nothing = NotContent@@ -502,12 +500,12 @@ case pc' x of Ignore -> CL.drop 1 >> takeContents front IsContent t -> CL.drop 1 >> takeContents (front . (:) t)- IsError e -> lift $ C.resourceThrow $ XmlException e x+ IsError e -> lift $ C.monadThrow $ XmlException e x NotContent -> return $ T.concat $ front [] -- | Grabs the next piece of content. If none if available, returns 'T.empty'. -- This is simply a wrapper around 'contentMaybe'.-content :: C.ResourceThrow m => C.Sink Event m Text+content :: C.MonadThrow m => C.Sink Event m Text content = do x <- contentMaybe case x of@@ -523,7 +521,7 @@ -- consumed. If you want to allow extra attributes, see 'ignoreAttrs'. -- -- This function automatically ignores comments, instructions and whitespace.-tag :: C.ResourceThrow m+tag :: C.MonadThrow m => (Name -> Maybe a) -> (a -> AttrParser b) -> (b -> C.Sink Event m c)@@ -535,7 +533,7 @@ case checkName name of Just y -> case runAttrParser' (attrParser y) as of- Left e -> lift $ C.resourceThrow e+ Left e -> lift $ C.monadThrow e Right z -> do CL.drop 1 z' <- f z@@ -543,7 +541,7 @@ case a of Just (EventEndElement name') | name == name' -> CL.drop 1 >> return (Just z')- _ -> lift $ C.resourceThrow $ XmlException ("Expected end tag for: " ++ show name) a+ _ -> lift $ C.monadThrow $ XmlException ("Expected end tag for: " ++ show name) a Nothing -> return Nothing _ -> return Nothing where@@ -573,7 +571,7 @@ Right (attr, _) -> Left $ UnparsedAttributes attr -- | A simplified version of 'tag' which matches against boolean predicates.-tagPredicate :: C.ResourceThrow m+tagPredicate :: C.MonadThrow m => (Name -> Bool) -> AttrParser a -> (a -> C.Sink Event m b)@@ -584,7 +582,7 @@ -- of taking a predicate function. This is often sufficient, and when combined -- with OverloadedStrings and the IsString instance of 'Name', can prove to be -- very concise.-tagName :: C.ResourceThrow m+tagName :: C.MonadThrow m => Name -> AttrParser a -> (a -> C.Sink Event m b)@@ -592,14 +590,14 @@ tagName name = tagPredicate (== name) -- | A further simplified tag parser, which requires that no attributes exist.-tagNoAttr :: C.ResourceThrow m => Name -> C.Sink Event m a -> C.Sink Event m (Maybe a)+tagNoAttr :: C.MonadThrow m => Name -> C.Sink Event m a -> C.Sink 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 :: C.Resource m => C.Sink Event m (Maybe a) -> C.Sink Event m (Maybe a) -> C.Sink Event m (Maybe a)+orE :: Monad m => C.Sink Event m (Maybe a) -> C.Sink Event m (Maybe a) -> C.Sink Event m (Maybe a) orE a b = do x <- a case x of@@ -608,7 +606,7 @@ -- | Get the value of the first parser which returns 'Just'. If no parsers -- succeed (i.e., return 'Just'), this function returns 'Nothing'.-choose :: C.Resource m+choose :: Monad m => [C.Sink Event m (Maybe a)] -> C.Sink Event m (Maybe a) choose [] = return Nothing@@ -621,27 +619,27 @@ -- | Force an optional parser into a required parser. All of the 'tag' -- functions, 'choose' and 'many' deal with 'Maybe' parsers. Use this when you -- want to finally force something to happen.-force :: C.ResourceThrow m+force :: C.MonadThrow m => String -- ^ Error message -> C.Sink Event m (Maybe a) -> C.Sink Event m a force msg i = do x <- i case x of- Nothing -> lift $ resourceThrow $ XmlException msg Nothing+ Nothing -> lift $ monadThrow $ XmlException msg Nothing Just a -> return a -- | A helper function which reads a file from disk using 'enumFile', detects -- character encoding using 'detectUtf', parses the XML using 'parseBytes', and -- then hands off control to your supplied parser.-parseFile :: (ResourceIO m, C.ResourceThrow m)+parseFile :: MonadResource m => ParseSettings -> FilePath -> C.Source m Event parseFile ps fp = sourceFile (encodeString fp) C.$= parseBytes ps -- | Parse an event stream from a lazy 'L.ByteString'.-parseLBS :: C.ResourceThrow m+parseLBS :: C.MonadThrow m => ParseSettings -> L.ByteString -> C.Source m Event@@ -727,7 +725,7 @@ ignoreAttrs = AttrParser $ \_ -> Right ([], ()) -- | Keep parsing elements as long as the parser returns 'Just'.-many :: C.Resource m => C.Sink Event m (Maybe a) -> C.Sink Event m [a]+many :: Monad m => C.Sink Event m (Maybe a) -> C.Sink Event m [a] many i = go id where
Text/XML/Stream/Render.hs view
@@ -30,20 +30,20 @@ import qualified Data.Conduit as C import qualified Data.Conduit.Text as CT import Control.Exception (assert)-import Control.Monad.Trans.Resource (ResourceUnsafeIO)+import Control.Monad.Trans.Resource (MonadUnsafeIO) -- | Render a stream of 'Event's into a stream of 'ByteString's. This function -- wraps around 'renderBuilder' and 'builderToByteString', so it produces -- optimally sized 'ByteString's with minimal buffer copying. -- -- The output is UTF8 encoded.-renderBytes :: ResourceUnsafeIO m => RenderSettings -> C.Conduit Event m ByteString+renderBytes :: MonadUnsafeIO m => RenderSettings -> C.Conduit Event m ByteString renderBytes rs = renderBuilder rs C.=$= 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 :: (C.ResourceThrow m, ResourceUnsafeIO m)+renderText :: (C.MonadThrow m, MonadUnsafeIO m) => RenderSettings -> C.Conduit Event m Text renderText rs = renderBytes rs C.=$= CT.decode CT.utf8 @@ -59,11 +59,11 @@ -- | 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 :: C.Resource m => RenderSettings -> C.Conduit Event m Builder+renderBuilder :: Monad m => RenderSettings -> C.Conduit Event m Builder renderBuilder RenderSettings { rsPretty = True } = prettify C.=$= renderBuilder' renderBuilder RenderSettings { rsPretty = False } = renderBuilder' -renderBuilder' :: C.Resource m => C.Conduit Event m Builder+renderBuilder' :: Monad m => C.Conduit Event m Builder renderBuilder' = C.conduitState (id, []) push@@ -194,10 +194,10 @@ -- | Convert a stream of 'Event's into a prettified one, adding extra -- whitespace. Note that this can change the meaning of your XML.-prettify :: C.Resource m => C.Conduit Event m Event+prettify :: Monad m => C.Conduit Event m Event prettify = prettify' 0 [] -prettify' :: C.Resource m => Int -> [Name] -> C.Conduit Event m Event+prettify' :: Monad m => Int -> [Name] -> C.Conduit Event m Event prettify' level0 names0 = C.conduitState (id, (level0, names0)) push
Text/XML/Stream/Token.hs view
@@ -6,7 +6,6 @@ , Token (..) , TAttribute , NSLevel (..)- , lazyConsumeNoResource ) where import Data.XML.Types (Instruction (..), Content (..), ExternalID (..))@@ -24,9 +23,6 @@ import qualified Data.Set as Set import Data.List (foldl') import Control.Arrow (first)-import Control.Monad.Trans.Control (MonadBaseControl, liftBaseOp_)-import Data.Conduit (Source, sourcePull, SourceResult (Open, Closed), ResourceT)-import System.IO.Unsafe (unsafeInterleaveIO) oneSpace :: Builder oneSpace = copyByteString " "@@ -175,15 +171,3 @@ | otherwise = TName (Just a) $ T.drop 1 b where (a, b) = T.break (== ':') t--lazyConsumeNoResource :: MonadBaseControl IO m => Source m a -> ResourceT m [a]-lazyConsumeNoResource src0 = do- go src0- where- go src = liftBaseOp_ unsafeInterleaveIO $ do- res <- sourcePull src- case res of- Closed -> return []- Open src' x -> do- y <- go src'- return $ x : y
Text/XML/Unresolved.hs view
@@ -55,14 +55,14 @@ import qualified Data.Conduit.Binary as CB import Control.Exception (throw) import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Resource (ResourceUnsafeIO, runExceptionT)+import Control.Monad.Trans.Resource (MonadUnsafeIO, runExceptionT) import Control.Monad.ST (runST)-import Text.XML.Stream.Token (lazyConsumeNoResource)+import Data.Conduit.Lazy (lazyConsume) readFile :: P.ParseSettings -> FilePath -> IO Document readFile ps fp = C.runResourceT $ P.parseFile ps fp C.$$ fromEvents -sinkDoc :: C.ResourceThrow m+sinkDoc :: C.MonadThrow m => P.ParseSettings -> C.Sink ByteString m Document sinkDoc ps = P.parseBytes ps C.=$ fromEvents @@ -76,14 +76,12 @@ -- not generally safe, but we know that runResourceT -- will not deallocate any of the resources being used -- by the process- $ C.runResourceT- $ lazyConsumeNoResource+ $ lazyConsume $ renderBytes rs doc parseLBS :: P.ParseSettings -> L.ByteString -> Either SomeException Document parseLBS ps lbs = runST $ runExceptionT- $ C.runResourceT $ CL.sourceList (L.toChunks lbs) C.$$ sinkDoc ps parseLBS_ :: P.ParseSettings -> L.ByteString -> Document@@ -93,16 +91,16 @@ deriving (Show, Typeable) instance Exception InvalidEventStream -renderBuilder :: C.Resource m => R.RenderSettings -> Document -> C.Source m Builder+renderBuilder :: Monad m => R.RenderSettings -> Document -> C.Source m Builder renderBuilder rs doc = CL.sourceList (toEvents doc) C.$= R.renderBuilder rs -renderBytes :: ResourceUnsafeIO m => R.RenderSettings -> Document -> C.Source m ByteString+renderBytes :: MonadUnsafeIO m => R.RenderSettings -> Document -> C.Source m ByteString renderBytes rs doc = CL.sourceList (toEvents doc) C.$= R.renderBytes rs -renderText :: (C.ResourceThrow m, ResourceUnsafeIO m) => R.RenderSettings -> Document -> C.Source m Text+renderText :: (C.MonadThrow m, MonadUnsafeIO m) => R.RenderSettings -> Document -> C.Source m Text renderText rs doc = CL.sourceList (toEvents doc) C.$= R.renderText rs -fromEvents :: C.ResourceThrow m => C.Sink Event m Document+fromEvents :: C.MonadThrow m => C.Sink Event m Document fromEvents = do skip EventBeginDocument d <- Document <$> goP <*> require goE <*> goM@@ -110,7 +108,7 @@ y <- CL.head if y == Nothing then return d- else lift $ C.resourceThrow $ InvalidEventStream $ "Trailing matter after epilogue: " ++ show y+ else lift $ C.monadThrow $ InvalidEventStream $ "Trailing matter after epilogue: " ++ show y where skip e = do x <- CL.peek@@ -130,7 +128,7 @@ Just y -> return y Nothing -> do y <- CL.head- lift $ C.resourceThrow $ InvalidEventStream $ "Document must have a single root element, got: " ++ show y+ lift $ C.monadThrow $ InvalidEventStream $ "Document must have a single root element, got: " ++ show y goP = Prologue <$> goM <*> goD <*> goM goM = many goM' goM' = do@@ -158,7 +156,7 @@ -- -- Just (EventDeclaration _) -> dropTillDoctype Just EventEndDoctype -> return ()- _ -> lift $ C.resourceThrow $ InvalidEventStream $ "Invalid event during doctype, got: " ++ show x+ _ -> lift $ C.monadThrow $ InvalidEventStream $ "Invalid event during doctype, got: " ++ show x goE = do x <- CL.peek case x of@@ -170,7 +168,7 @@ y <- CL.head if y == Just (EventEndElement n) then return $ Element n as $ compressNodes ns- else lift $ C.resourceThrow $ InvalidEventStream $ "Missing end element for " ++ show n ++ ", got: " ++ show y+ else lift $ C.monadThrow $ InvalidEventStream $ "Missing end element for " ++ show n ++ ", got: " ++ show y goN = do x <- CL.peek case x of
xml-conduit.cabal view
@@ -1,5 +1,5 @@ name: xml-conduit-version: 0.5.4+version: 0.6.0 license: BSD3 license-file: LICENSE author: Michael Snoyman <michaels@suite-sol.com>, Aristid Breitkreuz <aristidb@googlemail.com>@@ -28,9 +28,10 @@ library build-depends: base >= 4 && < 5- , conduit >= 0.2 && < 0.3- , attoparsec-conduit >= 0.2 && < 0.3- , blaze-builder-conduit >= 0.2 && < 0.3+ , conduit >= 0.3 && < 0.4+ , resourcet >= 0.3 && < 0.4+ , attoparsec-conduit >= 0.3 && < 0.4+ , blaze-builder-conduit >= 0.3 && < 0.4 , bytestring >= 0.9 && < 0.10 , text >= 0.7 && < 0.12 , containers >= 0.2 && < 0.5