xml-conduit 1.3.2 → 1.3.3
raw patch · 6 files changed
+66/−19 lines, 6 files
Files
- ChangeLog.md +5/−0
- Text/XML.hs +1/−0
- Text/XML/Stream/Render.hs +30/−16
- Text/XML/Stream/Token.hs +5/−2
- test/main.hs +24/−0
- xml-conduit.cabal +1/−1
ChangeLog.md view
@@ -1,3 +1,8 @@+## 1.3.3++* New render setting to control when to use CDATA [#68](https://github.com/snoyberg/xml/pull/68)+* Escaping CDATA closing tag in CDATA [#69](https://github.com/snoyberg/xml/pull/69)+ ## 1.3.2 * Support for iso-8859-1 [#63](https://github.com/snoyberg/xml/issues/63)
Text/XML.hs view
@@ -62,6 +62,7 @@ , R.rsPretty , R.rsNamespaces , R.rsAttrOrder+ , R.rsUseCDATA , R.orderAttrs -- * Conversion , toXMLDocument
Text/XML/Stream/Render.hs view
@@ -15,6 +15,7 @@ , rsPretty , rsNamespaces , rsAttrOrder+ , rsUseCDATA , orderAttrs -- * Event rendering , tag@@ -72,6 +73,13 @@ , 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+ -- ^ Determines if for a given text content the renderer should use a+ -- CDATA node.+ --+ -- Default: @False@+ --+ -- @since 1.3.3 } instance Default RenderSettings where@@ -79,6 +87,7 @@ { rsPretty = False , rsNamespaces = [] , rsAttrOrder = const Map.toList+ , rsUseCDATA = const False } -- | Convenience function to create an ordering function suitable for@@ -106,11 +115,11 @@ -- the blaze-builder package, and allow the create of optimally sized -- 'ByteString's with minimal buffer copying. 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 RenderSettings { rsPretty = True, rsNamespaces = n, rsUseCDATA = useCDATA } = prettify =$= renderBuilder' n True useCDATA+renderBuilder RenderSettings { rsPretty = False, rsNamespaces = n, rsUseCDATA = useCDATA } = renderBuilder' n False useCDATA -renderBuilder' :: Monad m => [(Text, Text)] -> Bool -> Conduit Event m Builder-renderBuilder' namespaces0 isPretty = do+renderBuilder' :: Monad m => [(Text, Text)] -> Bool -> (Content -> Bool) -> Conduit Event m Builder+renderBuilder' namespaces0 isPretty useCDATA = do loop [] where loop nslevels = await >>= maybe (return ()) (go nslevels)@@ -129,29 +138,34 @@ yield token loop nslevels' _ -> do- let (token, nslevels') = eventToToken nslevels e+ let (token, nslevels') = eventToToken nslevels useCDATA e yield token loop nslevels' -eventToToken :: Stack -> Event -> (Builder, [NSLevel])-eventToToken s EventBeginDocument =+eventToToken :: Stack -> (Content -> Bool) -> Event -> (Builder, [NSLevel])+eventToToken s _ EventBeginDocument = (tokenToBuilder $ TokenBeginDocument [ ("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 _ 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 (EventContent c) = (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 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 type Stack = [NSLevel]
Text/XML/Stream/Token.hs view
@@ -68,9 +68,9 @@ , fromByteString ">" ] tokenToBuilder (TokenContent c) = contentToText c-tokenToBuilder (TokenCDATA t) =+tokenToBuilder (TokenCDATA t) = copyByteString "<![CDATA["- `mappend` fromText t+ `mappend` escCDATA t `mappend` copyByteString "]]>" tokenToBuilder (TokenComment t) = mconcat [fromByteString "<!--", fromText t, fromByteString "-->"] tokenToBuilder (TokenDoctype name eid _) = mconcat@@ -171,3 +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)
test/main.hs view
@@ -94,6 +94,8 @@ it "parsing CDATA" caseParseCdata it "retains namespaces when asked" caseRetainNamespaces it "handles iso-8859-1" caseIso8859_1+ it "renders CDATA when asked" caseRenderCDATA + it "escapes CDATA closing tag in CDATA" caseEscapesCDATA documentParseRender :: IO () documentParseRender =@@ -618,3 +620,25 @@ Map.empty [Res.NodeContent "\232"]) []++caseRenderCDATA :: Assertion+caseRenderCDATA = do+ let doc = Res.Document (Res.Prologue [] Nothing [])+ (Res.Element "a" Map.empty+ [ Res.NodeContent "www.google.com"+ ])+ []+ withoutCDATA = Res.renderLBS def doc+ withCDATA = Res.renderLBS (def { Res.rsUseCDATA = const True }) doc+ withCDATA `shouldBe` "<?xml version=\"1.0\" encoding=\"UTF-8\"?><a><![CDATA[www.google.com]]></a>"+ withoutCDATA `shouldBe` "<?xml version=\"1.0\" encoding=\"UTF-8\"?><a>www.google.com</a>"++caseEscapesCDATA :: Assertion+caseEscapesCDATA = do+ let doc = Res.Document (Res.Prologue [] Nothing [])+ (Res.Element "a" Map.empty+ [ Res.NodeContent "]]>"+ ])+ []+ result = Res.renderLBS (def { Res.rsUseCDATA = const True }) doc+ result `shouldBe` "<?xml version=\"1.0\" encoding=\"UTF-8\"?><a><![CDATA[]]]]><![CDATA[>]]></a>"
xml-conduit.cabal view
@@ -1,5 +1,5 @@ name: xml-conduit-version: 1.3.2+version: 1.3.3 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>, Aristid Breitkreuz <aristidb@googlemail.com>