diff --git a/src/Text/Taggy/Renderer.hs b/src/Text/Taggy/Renderer.hs index 0dd4220..da13c0b 100644 --- a/src/Text/Taggy/Renderer.hs +++ b/src/Text/Taggy/Renderer.hs @@ -15,28 +15,34 @@ import Text.Taggy.DOM (Element(..), Node(..)) import qualified Data.Text.Lazy as Lazy (Text) import Text.Blaze.Internal (ChoiceString(..), StaticString(..), MarkupM(..)) +-- renderMarkup does entity conversion implicitly, and an override at the +-- constructor level is needed to control this; `PreEscaped (Text s)` is not +-- escaped, but a naked `Text s` is. + class AsMarkup a where - toMarkup :: a -> Markup + -- If the first parameter is true, we align the constructors for entity + -- conversion. + toMarkup :: Bool -> a -> Markup instance AsMarkup Node where - toMarkup = \case - NodeContent text -> Content $ Text text - NodeElement elmt -> toMarkup elmt + toMarkup convertEntities = \case + NodeContent text -> Content $ if convertEntities then Text text else PreEscaped (Text text) + NodeElement elmt -> toMarkup convertEntities elmt instance AsMarkup Element where - toMarkup Element{..} = eltAttrs `toAttribute` Parent tag begin end kids + toMarkup convertEntities Element{..} = eltAttrs `toAttribute` Parent tag begin end kids where tag = toStatic eltName begin = toStatic $ "<" <> eltName end = toStatic $ " eltName <> ">" - kids = foldMap toMarkup eltChildren + kids = foldMap (toMarkup convertEntities) eltChildren class Renderable a where render :: a -> Lazy.Text + render = renderWith True + renderWith :: Bool -> a -> Lazy.Text instance AsMarkup a => Renderable a where - render = renderMarkup . toMarkup - ------------------------------------------------------------------------- + renderWith = fmap renderMarkup . toMarkup toAttribute :: HashMap Text Text -> (Markup -> Markup) toAttribute = flip $ foldlWithKey' toAttribute' diff --git a/tests/Text/Taggy/RendererSpec.hs b/tests/Text/Taggy/RendererSpec.hs index e6b60f4..ca838fb 100644 --- a/tests/Text/Taggy/RendererSpec.hs +++ b/tests/Text/Taggy/RendererSpec.hs @@ -15,3 +15,10 @@ spec = do render node `shouldBe` doc it "Should render a given element." $ do render elmt `shouldBe` doc + describe "renderWith" $ do + let document = "I ♥ you!" + element = (\(NodeElement e) -> e) . head . domify $ taggyWith False document + it "Should escape HTML entities when the first argument is True." $ do + renderWith True element `shouldBe` "I &hearts; you!" + it "Shouldn't escape HTML entities when the first argument is False." $ do + renderWith False element `shouldBe` document