{-# LANGUAGE OverloadedStrings #-} -- | A renderer that produces a lazy 'L.Text' value, using the Text Builder. -- module Text.Blaze.Renderer.Text ( renderMarkupBuilder , renderMarkupBuilderWith , renderMarkup , renderMarkupWith , renderHtmlBuilder , renderHtmlBuilderWith , renderHtml , renderHtmlWith ) where import Data.Monoid (mappend, mempty) import Data.List (isInfixOf) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8) import qualified Data.Text.Lazy as L import Data.ByteString (ByteString) import qualified Data.ByteString as S (isInfixOf) import Text.Blaze.Internal import Data.Text.Lazy.Builder (Builder) import qualified Data.Text.Lazy.Builder as B -- | Escape predefined XML entities in a text value -- escapeMarkupEntities :: Text -- ^ Text to escape -> Builder -- ^ Resulting text builder escapeMarkupEntities = T.foldr escape mempty where escape :: Char -> Builder -> Builder escape '<' b = B.fromText "&lt;" `mappend` b escape '>' b = B.fromText "&gt;" `mappend` b escape '&' b = B.fromText "&amp;" `mappend` b escape '"' b = B.fromText "&quot;" `mappend` b escape '\'' b = B.fromText "&#39;" `mappend` b escape x b = B.singleton x `mappend` b -- | Render a 'ChoiceString'. TODO: Optimization possibility, apply static -- argument transformation. -- fromChoiceString :: (ByteString -> Text) -- ^ Decoder for bytestrings -> ChoiceString -- ^ String to render -> Builder -- ^ Resulting builder fromChoiceString _ (Static s) = B.fromText $ getText s fromChoiceString _ (String s) = escapeMarkupEntities $ T.pack s fromChoiceString _ (Text s) = escapeMarkupEntities s fromChoiceString d (ByteString s) = B.fromText $ d s fromChoiceString d (PreEscaped x) = case x of String s -> B.fromText $ T.pack s Text s -> B.fromText s s -> fromChoiceString d s fromChoiceString d (External x) = case x of -- Check that the sequence "</" is *not* in the external data. String s -> if "</" `isInfixOf` s then mempty else B.fromText (T.pack s) Text s -> if "</" `T.isInfixOf` s then mempty else B.fromText s ByteString s -> if "</" `S.isInfixOf` s then mempty else B.fromText (d s) s -> fromChoiceString d s fromChoiceString d (AppendChoiceString x y) = fromChoiceString d x `mappend` fromChoiceString d y fromChoiceString _ EmptyChoiceString = mempty {-# INLINE fromChoiceString #-} -- | Render markup to a text builder renderMarkupBuilder :: Markup -> Builder renderMarkupBuilder = renderMarkupBuilderWith decodeUtf8 {-# INLINE renderMarkupBuilder #-} renderHtmlBuilder :: Markup -> Builder renderHtmlBuilder = renderMarkupBuilder {-# INLINE renderHtmlBuilder #-} {-# DEPRECATED renderHtmlBuilder "Use renderHtmlBuilder from Text.Blaze.Html.Renderer.Text instead" #-} -- | Render some 'Markup' to a Text 'Builder'. -- renderMarkupBuilderWith :: (ByteString -> Text) -- ^ Decoder for bytestrings -> Markup -- ^ Markup to render -> Builder -- ^ Resulting builder renderMarkupBuilderWith d = go mempty where go :: Builder -> MarkupM b -> Builder go attrs (Parent _ open close content) = B.fromText (getText open) `mappend` attrs `mappend` B.singleton '>' `mappend` go mempty content `mappend` B.fromText (getText close) go attrs (CustomParent tag content) = B.singleton '<' `mappend` fromChoiceString d tag `mappend` attrs `mappend` B.singleton '>' `mappend` go mempty content `mappend` B.fromText "</" `mappend` fromChoiceString d tag `mappend` B.singleton '>' go attrs (Leaf _ begin end) = B.fromText (getText begin) `mappend` attrs `mappend` B.fromText (getText end) go attrs (CustomLeaf tag close) = B.singleton '<' `mappend` fromChoiceString d tag `mappend` attrs `mappend` (if close then B.fromText " />" else B.singleton '>') go attrs (AddAttribute _ key value h) = go (B.fromText (getText key) `mappend` fromChoiceString d value `mappend` B.singleton '"' `mappend` attrs) h go attrs (AddCustomAttribute key value h) = go (B.singleton ' ' `mappend` fromChoiceString d key `mappend` B.fromText "=\"" `mappend` fromChoiceString d value `mappend` B.singleton '"' `mappend` attrs) h go _ (Content content) = fromChoiceString d content go attrs (Append h1 h2) = go attrs h1 `mappend` go attrs h2 go _ Empty = mempty {-# NOINLINE go #-} {-# INLINE renderMarkupBuilderWith #-} renderHtmlBuilderWith :: (ByteString -> Text) -- ^ Decoder for bytestrings -> Markup -- ^ Markup to render -> Builder -- ^ Resulting builder renderHtmlBuilderWith = renderMarkupBuilderWith {-# INLINE renderHtmlBuilderWith #-} {-# DEPRECATED renderHtmlBuilderWith "Use renderHtmlBuilderWith from Text.Blaze.Html.Renderer.Text instead" #-} -- | Render markup to a lazy Text value. If there are any ByteString's in the -- input markup, this function will consider them as UTF-8 encoded values and -- decode them that way. -- renderMarkup :: Markup -> L.Text renderMarkup = renderMarkupWith decodeUtf8 {-# INLINE renderMarkup #-} renderHtml :: Markup -> L.Text renderHtml = renderMarkup {-# INLINE renderHtml #-} {-# DEPRECATED renderHtml "Use renderHtml from Text.Blaze.Html.Renderer.Text instead" #-} -- | Render markup to a lazy Text value. This function allows you to specify what -- should happen with ByteString's in the input HTML. You can decode them or -- drop them, this depends on the application... -- renderMarkupWith :: (ByteString -> Text) -- ^ Decoder for ByteString's. -> Markup -- ^ Markup to render -> L.Text -- Resulting lazy text renderMarkupWith d = B.toLazyText . renderMarkupBuilderWith d renderHtmlWith :: (ByteString -> Text) -- ^ Decoder for ByteString's. -> Markup -- ^ Markup to render -> L.Text -- ^ Resulting lazy text renderHtmlWith = renderMarkupWith {-# DEPRECATED renderHtmlWith "Use renderHtmlWith from Text.Blaze.Html.Renderer.Text instead" #-}