{-# 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 Char
'<'  Builder
b = Text -> Builder
B.fromText Text
"&lt;"   Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape Char
'>'  Builder
b = Text -> Builder
B.fromText Text
"&gt;"   Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape Char
'&'  Builder
b = Text -> Builder
B.fromText Text
"&amp;"  Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape Char
'"'  Builder
b = Text -> Builder
B.fromText Text
"&quot;" Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape Char
'\'' Builder
b = Text -> Builder
B.fromText Text
"&#39;"  Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape Char
x    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 ByteString -> Text
_ (Static StaticString
s)     = Text -> Builder
B.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ StaticString -> Text
getText StaticString
s
fromChoiceString ByteString -> Text
_ (String String
s)     = Text -> Builder
escapeMarkupEntities (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
fromChoiceString ByteString -> Text
_ (Text Text
s)       = Text -> Builder
escapeMarkupEntities Text
s
fromChoiceString ByteString -> Text
d (ByteString ByteString
s) = Text -> Builder
B.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
d ByteString
s
fromChoiceString ByteString -> Text
d (PreEscaped ChoiceString
x) = case ChoiceString
x of
    String String
s -> Text -> Builder
B.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
    Text   Text
s -> Text -> Builder
B.fromText Text
s
    ChoiceString
s        -> (ByteString -> Text) -> ChoiceString -> Builder
fromChoiceString ByteString -> Text
d ChoiceString
s
fromChoiceString ByteString -> Text
d (External ChoiceString
x) = case ChoiceString
x of
    -- Check that the sequence "</" is *not* in the external data.
    String String
s     -> if String
"</" 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   Text
s     -> if Text
"</" Text -> Text -> Bool
`T.isInfixOf` Text
s then Builder
forall a. Monoid a => a
mempty else Text -> Builder
B.fromText Text
s
    ByteString ByteString
s -> if ByteString
"</" 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)
    ChoiceString
s            -> (ByteString -> Text) -> ChoiceString -> Builder
fromChoiceString ByteString -> Text
d ChoiceString
s
fromChoiceString ByteString -> Text
d (AppendChoiceString ChoiceString
x 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 ByteString -> Text
_ ChoiceString
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 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 Builder
attrs (Parent StaticString
_ StaticString
open StaticString
close 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 Char
'>'
            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 Builder
attrs (CustomParent ChoiceString
tag MarkupM b
content) =
        Char -> Builder
B.singleton Char
'<'
            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 Char
'>'
            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 Text
"</"
            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 Char
'>'
    go Builder
attrs (Leaf StaticString
_ StaticString
begin StaticString
end b
_) =
        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 Builder
attrs (CustomLeaf ChoiceString
tag Bool
close b
_) =
        Char -> Builder
B.singleton Char
'<'
            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 Text
" />" else Char -> Builder
B.singleton Char
'>')
    go Builder
attrs (AddAttribute StaticString
_ StaticString
key ChoiceString
value 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 Char
'"'
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
attrs) MarkupM b
h
    go Builder
attrs (AddCustomAttribute ChoiceString
key ChoiceString
value MarkupM b
h) =
        Builder -> MarkupM b -> Builder
forall b. Builder -> MarkupM b -> Builder
go (Char -> Builder
B.singleton Char
' '
            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 Text
"=\""
            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 Char
'"'
            Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
attrs) MarkupM b
h
    go Builder
_ (Content ChoiceString
content b
_) = (ByteString -> Text) -> ChoiceString -> Builder
fromChoiceString ByteString -> Text
d ChoiceString
content
    go Builder
_ (Comment ChoiceString
comment b
_) =
        Text -> Builder
B.fromText Text
"<!-- "
            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` Builder
" -->"
    go Builder
attrs (Append MarkupM b
h1 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 Builder
_ (Empty b
_) = 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 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" #-}