xml-conduit 1.5.0 → 1.5.1
raw patch · 7 files changed
+54/−27 lines, 7 files
Files
- ChangeLog.md +4/−0
- Text/XML.hs +1/−0
- Text/XML/Stream/Parse.hs +14/−10
- Text/XML/Stream/Render.hs +23/−14
- Text/XML/Stream/Token.hs +2/−2
- test/main.hs +9/−0
- xml-conduit.cabal +1/−1
ChangeLog.md view
@@ -1,3 +1,7 @@+## 1.5.1++* New render setting, `rsXMLDeclaration`; setting it to `False` omits the XML declaration.+ ## 1.5.0 * `tag` function no longer throws an exception when attributes don't match [#93](https://github.com/snoyberg/xml/pull/93)
Text/XML.hs view
@@ -63,6 +63,7 @@ , R.rsNamespaces , R.rsAttrOrder , R.rsUseCDATA+ , R.rsXMLDeclaration , R.orderAttrs -- * Conversion , toXMLDocument
Text/XML/Stream/Parse.hs view
@@ -34,10 +34,12 @@ -- > data Person = Person Int Text -- > deriving Show -- >--- > parsePerson = tagName "person" (requireAttr "age") $ \age -> do+-- > parsePerson :: MonadThrow m => Consumer Event m (Maybe Person)+-- > parsePerson = tag' "person" (requireAttr "age") $ \age -> do -- > name <- content -- > return $ Person (read $ unpack age) name -- >+-- > parsePeople :: MonadThrow m => Sink Event m (Maybe [Person]) -- > parsePeople = tagNoAttr "people" $ many parsePerson -- > -- > main = do@@ -47,7 +49,7 @@ -- -- will produce: ----- > [Person {age = 25, name = "Michael"},Person {age = 2, name = "Eliezer"}]+-- > [Person 25 "Michael",Person 2 "Eliezer"] -- -- This module also supports streaming results using 'yield'. -- This allows parser results to be processed using conduits@@ -58,21 +60,23 @@ -- See http://stackoverflow.com/q/21367423/2597135 for a related discussion. -- -- > {-# LANGUAGE OverloadedStrings #-}+-- > import Control.Monad (void)+-- > import Control.Monad.Trans.Class (lift) -- > import Control.Monad.Trans.Resource -- > import Data.Conduit+-- > import qualified Data.Conduit.List as CL -- > import Data.Text (Text, unpack)+-- > import Data.XML.Types (Event) -- > import Text.XML.Stream.Parse--- > import Text.XML (Name)--- > import Control.Monad.Trans.Class (lift)--- > import Control.Monad (void)--- > import qualified Data.Conduit.List as CL -- > -- > data Person = Person Int Text deriving Show -- >--- > parsePerson = tagName "person" (requireAttr "age") $ \age -> do+-- > parsePerson :: MonadThrow m => Consumer Event m (Maybe Person)+-- > parsePerson = tag' "person" (requireAttr "age") $ \age -> do -- > name <- content -- > return $ Person (read $ unpack age) name -- >+-- > parsePeople :: MonadThrow m => Conduit Event m Person -- > parsePeople = void $ tagNoAttr "people" $ manyYield parsePerson -- > -- > main = runResourceT $@@ -200,7 +204,7 @@ type Ents = [(Text, Text)] tokenToEvent :: ParseSettings -> Ents -> [NSLevel] -> Token -> (Ents, [NSLevel], [Event])-tokenToEvent _ es n (TokenBeginDocument _) = (es, n, [])+tokenToEvent _ es n (TokenXMLDeclaration _) = (es, n, []) tokenToEvent _ es n (TokenInstruction i) = (es, n, [EventInstruction i]) tokenToEvent ps es n (TokenBeginElement name as isClosed _) = (es, n', if isClosed then [begin, end] else [begin])@@ -314,7 +318,7 @@ case parser $ decodeUtf8With lenientDecode nextChunk of AT.Fail{} -> fallback AT.Partial f -> await >>= maybe fallback (loop chunks f)- AT.Done _ (TokenBeginDocument attrs) -> findEncoding attrs+ AT.Done _ (TokenXMLDeclaration attrs) -> findEncoding attrs AT.Done{} -> fallback where chunks = nextChunk : chunks0@@ -450,7 +454,7 @@ char' '?' char' '>' newline <|> return ()- return $ TokenBeginDocument as+ return $ TokenXMLDeclaration as else do skipSpace x <- T.pack <$> manyTill anyChar (try $ string "?>")
Text/XML/Stream/Render.hs view
@@ -18,6 +18,7 @@ , rsNamespaces , rsAttrOrder , rsUseCDATA+ , rsXMLDeclaration , orderAttrs -- * Event rendering , tag@@ -83,6 +84,12 @@ -- Default: @False@ -- -- @since 1.3.3+ , rsXMLDeclaration :: Bool+ -- ^ Determines whether the XML declaration will be output.+ --+ -- Default: @True@+ --+ -- @since 1.5.1 } instance Default RenderSettings where@@ -91,6 +98,7 @@ , rsNamespaces = [] , rsAttrOrder = const Map.toList , rsUseCDATA = const False+ , rsXMLDeclaration = True } -- | Convenience function to create an ordering function suitable for@@ -139,7 +147,7 @@ renderEvent' = renderEvent yield' settings renderEvent :: Monad m => (Flush Builder -> Producer m o) -> RenderSettings -> Conduit (Flush Event) m o-renderEvent yield' RenderSettings { rsPretty = isPretty, rsNamespaces = namespaces0, rsUseCDATA = useCDATA } =+renderEvent yield' RenderSettings { rsPretty = isPretty, rsNamespaces = namespaces0, rsUseCDATA = useCDATA, rsXMLDeclaration = useXMLDecl } = loop [] where loop nslevels = await >>= maybe (return ()) (go nslevels)@@ -159,34 +167,35 @@ yield' $ Chunk token loop nslevels' _ -> do- let (token, nslevels') = eventToToken nslevels useCDATA e+ let (token, nslevels') = eventToToken nslevels useCDATA useXMLDecl e yield' $ Chunk token loop nslevels' -eventToToken :: Stack -> (Content -> Bool) -> Event -> (Builder, [NSLevel])-eventToToken s _ EventBeginDocument =- (tokenToBuilder $ TokenBeginDocument+eventToToken :: Stack -> (Content -> Bool) -> Bool -> Event -> (Builder, [NSLevel])+eventToToken s _ True EventBeginDocument =+ (tokenToBuilder $ TokenXMLDeclaration [ ("version", [ContentText "1.0"]) , ("encoding", [ContentText "UTF-8"]) ] , s)-eventToToken s _ EventEndDocument = (mempty, s)-eventToToken s _ (EventInstruction i) = (tokenToBuilder $ TokenInstruction i, s)-eventToToken s _ (EventBeginDoctype n meid) = (tokenToBuilder $ TokenDoctype n meid [], s)-eventToToken s _ EventEndDoctype = (mempty, s)-eventToToken s _ (EventCDATA t) = (tokenToBuilder $ TokenCDATA t, s)-eventToToken s _ (EventEndElement name) =+eventToToken s _ False EventBeginDocument = (mempty, s)+eventToToken s _ _ EventEndDocument = (mempty, s)+eventToToken s _ _ (EventInstruction i) = (tokenToBuilder $ TokenInstruction i, s)+eventToToken s _ _ (EventBeginDoctype n meid) = (tokenToBuilder $ TokenDoctype n meid [], s)+eventToToken s _ _ EventEndDoctype = (mempty, s)+eventToToken s _ _ (EventCDATA t) = (tokenToBuilder $ TokenCDATA t, s)+eventToToken s _ _ (EventEndElement name) = (tokenToBuilder $ TokenEndElement $ nameToTName sl name, s') where (sl:s') = s-eventToToken s useCDATA (EventContent c)+eventToToken s useCDATA _ (EventContent c) | useCDATA c = case c of 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)-eventToToken _ _ EventBeginElement{} = error "eventToToken on EventBeginElement" -- mkBeginToken False s name attrs+eventToToken s _ _ (EventComment t) = (tokenToBuilder $ TokenComment t, s)+eventToToken _ _ _ EventBeginElement{} = error "eventToToken on EventBeginElement" -- mkBeginToken False s name attrs type Stack = [NSLevel]
Text/XML/Stream/Token.hs view
@@ -27,7 +27,7 @@ oneSpace :: Builder oneSpace = copyByteString " " -data Token = TokenBeginDocument [TAttribute]+data Token = TokenXMLDeclaration [TAttribute] | TokenInstruction Instruction | TokenBeginElement TName [TAttribute] Bool Int -- ^ indent | TokenEndElement TName@@ -37,7 +37,7 @@ | TokenCDATA Text deriving Show tokenToBuilder :: Token -> Builder-tokenToBuilder (TokenBeginDocument attrs) =+tokenToBuilder (TokenXMLDeclaration attrs) = fromByteString "<?xml" `mappend` foldAttrs oneSpace attrs (fromByteString "?>") tokenToBuilder (TokenInstruction (Instruction target data_)) = mconcat
test/main.hs view
@@ -51,6 +51,7 @@ it "strips duplicated attributes" stripDuplicateAttributes it "displays comments" testRenderComments it "conduit parser" testConduitParser+ it "can omit the XML declaration" omitXMLDeclaration describe "XML Cursors" $ do it "has correct parent" cursorParent it "has correct ancestor" cursorAncestor@@ -527,6 +528,14 @@ ma <- P.tagNoAttr "item" (return 1) maybe (return ()) (\a -> C.yield a >> f) ma +omitXMLDeclaration :: Assertion+omitXMLDeclaration = Res.renderLBS settings input @?= spec+ where+ settings = def { Res.rsXMLDeclaration = False }+ input = Res.Document (Prologue [] Nothing [])+ (Res.Element "foo" Map.empty [Res.NodeContent "bar"])+ []+ spec = "<foo>bar</foo>" name :: [Cu.Cursor] -> [Text] name [] = []
xml-conduit.cabal view
@@ -1,5 +1,5 @@ name: xml-conduit-version: 1.5.0+version: 1.5.1 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>, Aristid Breitkreuz <aristidb@googlemail.com>