{-# 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 :: Text -> Builder
escapeMarkupEntities = (Char -> Builder -> Builder) -> Builder -> Text -> Builder
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr Char -> Builder -> Builder
escape Builder
forall a. Monoid a => a
mempty
  where
    escape :: Char -> Builder -> Builder
    escape :: Char -> Builder -> Builder
escape '<'  b :: Builder
b = Text -> Builder
B.fromText "&lt;"   Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape '>'  b :: Builder
b = Text -> Builder
B.fromText "&gt;"   Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape '&'  b :: Builder
b = Text -> Builder
B.fromText "&amp;"  Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape '"'  b :: Builder
b = Text -> Builder
B.fromText "&quot;" Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape '\'' b :: Builder
b = Text -> Builder
B.fromText "&#39;"  Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape x :: Char
x    b :: Builder
b = Char -> Builder
B.singleton Char
x       Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
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 :: (ByteString -> Text) -> ChoiceString -> Builder
fromChoiceString _ (Static s :: StaticString
s)     = Text -> Builder
B.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ StaticString -> Text
getText StaticString
s
fromChoiceString _ (String s :: String
s)     = Text -> Builder
escapeMarkupEntities (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
fromChoiceString _ (Text s :: Text
s)       = Text -> Builder
escapeMarkupEntities Text
s
fromChoiceString d :: ByteString -> Text
d (ByteString s :: ByteString
s) = Text -> Builder
B.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
d ByteString
s
fromChoiceString d :: ByteString -> Text
d (PreEscaped x :: ChoiceString
x) = case ChoiceString
x of
    String s :: String
s -> Text -> Builder
B.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
    Text   s :: Text
s -> Text -> Builder
B.fromText Text
s
    s :: ChoiceString
s        -> (ByteString -> Text) -> ChoiceString -> Builder
fromChoiceString ByteString -> Text
d ChoiceString
s
fromChoiceString d :: ByteString -> Text
d (External x :: ChoiceString
x) = case ChoiceString
x of
    -- Check that the sequence "</" is *not* in the external data.
    String s :: String
s     -> if "</" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
s then Builder
forall a. Monoid a => a
mempty else Text -> Builder
B.fromText (String -> Text
T.pack String
s)
    Text   s :: Text
s     -> if "</" Text -> Text -> Bool
`T.isInfixOf` Text
s then Builder
forall a. Monoid a => a
mempty else Text -> Builder
B.fromText Text
s
    ByteString s :: ByteString
s -> if "</" ByteString -> ByteString -> Bool
`S.isInfixOf` ByteString
s then Builder
forall a. Monoid a => a
mempty else Text -> Builder
B.fromText (ByteString -> Text
d ByteString
s)
    s :: ChoiceString
s            -> (ByteString -> Text) -> ChoiceString -> Builder
fromChoiceString ByteString -> Text
d ChoiceString
s
fromChoiceString d :: ByteString -> Text
d (AppendChoiceString x :: ChoiceString
x y :: ChoiceString
y) =
    (ByteString -> Text) -> ChoiceString -> Builder
fromChoiceString ByteString -> Text
d ChoiceString
x Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` (ByteString -> Text) -> ChoiceString -> Builder
fromChoiceString ByteString -> Text
d ChoiceString
y
fromChoiceString _ EmptyChoiceString = Builder
forall a. Monoid a => a
mempty
{-# INLINE fromChoiceString #-}

-- | Render markup to a text builder
renderMarkupBuilder :: Markup -> Builder
renderMarkupBuilder :: Markup -> Builder
renderMarkupBuilder = (ByteString -> Text) -> Markup -> Builder
renderMarkupBuilderWith ByteString -> Text
decodeUtf8
{-# INLINE renderMarkupBuilder #-}

renderHtmlBuilder :: Markup -> Builder
renderHtmlBuilder :: Markup -> Builder
renderHtmlBuilder = Markup -> Builder
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 :: (ByteString -> Text) -> Markup -> Builder
renderMarkupBuilderWith d :: ByteString -> Text
d = Builder -> Markup -> Builder
forall b. Builder -> MarkupM b -> Builder
go Builder
forall a. Monoid a => a
mempty
  where
    go :: Builder -> MarkupM b -> Builder
    go :: Builder -> MarkupM b -> Builder
go attrs :: Builder
attrs (Parent _ open :: StaticString
open close :: StaticString
close content :: MarkupM b
content) =
        Text -> Builder
B.fromText (StaticString -> Text
getText StaticString
open)
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
attrs
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
B.singleton '>'
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder -> MarkupM b -> Builder
forall b. Builder -> MarkupM b -> Builder
go Builder
forall a. Monoid a => a
mempty MarkupM b
content
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Text -> Builder
B.fromText (StaticString -> Text
getText StaticString
close)
    go attrs :: Builder
attrs (CustomParent tag :: ChoiceString
tag content :: MarkupM b
content) =
        Char -> Builder
B.singleton '<'
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` (ByteString -> Text) -> ChoiceString -> Builder
fromChoiceString ByteString -> Text
d ChoiceString
tag
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
attrs
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
B.singleton '>'
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder -> MarkupM b -> Builder
forall b. Builder -> MarkupM b -> Builder
go Builder
forall a. Monoid a => a
mempty MarkupM b
content
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Text -> Builder
B.fromText "</"
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` (ByteString -> Text) -> ChoiceString -> Builder
fromChoiceString ByteString -> Text
d ChoiceString
tag
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
B.singleton '>'
    go attrs :: Builder
attrs (Leaf _ begin :: StaticString
begin end :: StaticString
end _) =
        Text -> Builder
B.fromText (StaticString -> Text
getText StaticString
begin)
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
attrs
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Text -> Builder
B.fromText (StaticString -> Text
getText StaticString
end)
    go attrs :: Builder
attrs (CustomLeaf tag :: ChoiceString
tag close :: Bool
close _) =
        Char -> Builder
B.singleton '<'
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` (ByteString -> Text) -> ChoiceString -> Builder
fromChoiceString ByteString -> Text
d ChoiceString
tag
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
attrs
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` (if Bool
close then Text -> Builder
B.fromText " />" else Char -> Builder
B.singleton '>')
    go attrs :: Builder
attrs (AddAttribute _ key :: StaticString
key value :: ChoiceString
value h :: MarkupM b
h) =
        Builder -> MarkupM b -> Builder
forall b. Builder -> MarkupM b -> Builder
go (Text -> Builder
B.fromText (StaticString -> Text
getText StaticString
key)
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` (ByteString -> Text) -> ChoiceString -> Builder
fromChoiceString ByteString -> Text
d ChoiceString
value
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
B.singleton '"'
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
attrs) MarkupM b
h
    go attrs :: Builder
attrs (AddCustomAttribute key :: ChoiceString
key value :: ChoiceString
value h :: MarkupM b
h) =
        Builder -> MarkupM b -> Builder
forall b. Builder -> MarkupM b -> Builder
go (Char -> Builder
B.singleton ' '
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` (ByteString -> Text) -> ChoiceString -> Builder
fromChoiceString ByteString -> Text
d ChoiceString
key
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Text -> Builder
B.fromText "=\""
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` (ByteString -> Text) -> ChoiceString -> Builder
fromChoiceString ByteString -> Text
d ChoiceString
value
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
B.singleton '"'
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
attrs) MarkupM b
h
    go _ (Content content :: ChoiceString
content _) = (ByteString -> Text) -> ChoiceString -> Builder
fromChoiceString ByteString -> Text
d ChoiceString
content
    go _ (Comment comment :: ChoiceString
comment _) =
        Text -> Builder
B.fromText "<!-- "
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` (ByteString -> Text) -> ChoiceString -> Builder
fromChoiceString ByteString -> Text
d ChoiceString
comment
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` " -->"
    go attrs :: Builder
attrs (Append h1 :: MarkupM b
h1 h2 :: MarkupM b
h2) = Builder -> MarkupM b -> Builder
forall b. Builder -> MarkupM b -> Builder
go Builder
attrs MarkupM b
h1 Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder -> MarkupM b -> Builder
forall b. Builder -> MarkupM b -> Builder
go Builder
attrs MarkupM b
h2
    go _ (Empty _) = Builder
forall a. Monoid a => a
mempty
    {-# NOINLINE go #-}
{-# INLINE renderMarkupBuilderWith #-}

renderHtmlBuilderWith :: (ByteString -> Text)  -- ^ Decoder for bytestrings
                      -> Markup                -- ^ Markup to render
                      -> Builder               -- ^ Resulting builder
renderHtmlBuilderWith :: (ByteString -> Text) -> Markup -> Builder
renderHtmlBuilderWith = (ByteString -> Text) -> Markup -> Builder
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 :: Markup -> Text
renderMarkup = (ByteString -> Text) -> Markup -> Text
renderMarkupWith ByteString -> Text
decodeUtf8
{-# INLINE renderMarkup #-}

renderHtml :: Markup -> L.Text
renderHtml :: Markup -> Text
renderHtml = Markup -> Text
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 :: (ByteString -> Text) -> Markup -> Text
renderMarkupWith d :: ByteString -> Text
d = Builder -> Text
B.toLazyText (Builder -> Text) -> (Markup -> Builder) -> Markup -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Text) -> Markup -> Builder
renderMarkupBuilderWith ByteString -> Text
d

renderHtmlWith :: (ByteString -> Text)  -- ^ Decoder for ByteString's.
               -> Markup                -- ^ Markup to render
               -> L.Text                -- ^ Resulting lazy text
renderHtmlWith :: (ByteString -> Text) -> Markup -> Text
renderHtmlWith = (ByteString -> Text) -> Markup -> Text
renderMarkupWith
{-# DEPRECATED renderHtmlWith
    "Use renderHtmlWith from Text.Blaze.Html.Renderer.Text instead" #-}