-- | A renderer that produces a native Haskell 'String', mostly meant for
-- debugging purposes.
--
{-# LANGUAGE OverloadedStrings #-}
module Text.Blaze.Renderer.String
    ( fromChoiceString
    , renderMarkup
    , renderHtml
    ) where

import Data.List (isInfixOf)

import qualified Data.ByteString.Char8 as SBC
import qualified Data.Text as T
import qualified Data.ByteString as S

import Text.Blaze.Internal

-- | Escape predefined XML entities in a string
--
escapeMarkupEntities :: String  -- ^ String to escape
                   -> String  -- ^ String to append
                   -> String  -- ^ Resulting string
escapeMarkupEntities :: [Char] -> [Char] -> [Char]
escapeMarkupEntities []     [Char]
k = [Char]
k
escapeMarkupEntities (Char
c:[Char]
cs) [Char]
k = case Char
c of
    Char
'<'  -> Char
'&' forall a. a -> [a] -> [a]
: Char
'l' forall a. a -> [a] -> [a]
: Char
't' forall a. a -> [a] -> [a]
: Char
';'             forall a. a -> [a] -> [a]
: [Char] -> [Char] -> [Char]
escapeMarkupEntities [Char]
cs [Char]
k
    Char
'>'  -> Char
'&' forall a. a -> [a] -> [a]
: Char
'g' forall a. a -> [a] -> [a]
: Char
't' forall a. a -> [a] -> [a]
: Char
';'             forall a. a -> [a] -> [a]
: [Char] -> [Char] -> [Char]
escapeMarkupEntities [Char]
cs [Char]
k
    Char
'&'  -> Char
'&' forall a. a -> [a] -> [a]
: Char
'a' forall a. a -> [a] -> [a]
: Char
'm' forall a. a -> [a] -> [a]
: Char
'p' forall a. a -> [a] -> [a]
: Char
';'       forall a. a -> [a] -> [a]
: [Char] -> [Char] -> [Char]
escapeMarkupEntities [Char]
cs [Char]
k
    Char
'"'  -> Char
'&' forall a. a -> [a] -> [a]
: Char
'q' forall a. a -> [a] -> [a]
: Char
'u' forall a. a -> [a] -> [a]
: Char
'o' forall a. a -> [a] -> [a]
: Char
't' forall a. a -> [a] -> [a]
: Char
';' forall a. a -> [a] -> [a]
: [Char] -> [Char] -> [Char]
escapeMarkupEntities [Char]
cs [Char]
k
    Char
'\'' -> Char
'&' forall a. a -> [a] -> [a]
: Char
'#' forall a. a -> [a] -> [a]
: Char
'3' forall a. a -> [a] -> [a]
: Char
'9' forall a. a -> [a] -> [a]
: Char
';'       forall a. a -> [a] -> [a]
: [Char] -> [Char] -> [Char]
escapeMarkupEntities [Char]
cs [Char]
k
    Char
x    -> Char
x                                 forall a. a -> [a] -> [a]
: [Char] -> [Char] -> [Char]
escapeMarkupEntities [Char]
cs [Char]
k

-- | Render a 'ChoiceString'.
--
fromChoiceString :: ChoiceString  -- ^ String to render
                 -> String        -- ^ String to append
                 -> String        -- ^ Resulting string
fromChoiceString :: ChoiceString -> [Char] -> [Char]
fromChoiceString (Static StaticString
s)     = StaticString -> [Char] -> [Char]
getString StaticString
s
fromChoiceString (String [Char]
s)     = [Char] -> [Char] -> [Char]
escapeMarkupEntities [Char]
s
fromChoiceString (Text Text
s)       = [Char] -> [Char] -> [Char]
escapeMarkupEntities forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
s
fromChoiceString (ByteString ByteString
s) = (ByteString -> [Char]
SBC.unpack ByteString
s forall a. [a] -> [a] -> [a]
++)
fromChoiceString (PreEscaped ChoiceString
x) = case ChoiceString
x of
    String [Char]
s -> ([Char]
s forall a. [a] -> [a] -> [a]
++)
    Text   Text
s -> (\[Char]
k -> forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr (:) [Char]
k Text
s)
    ChoiceString
s        -> ChoiceString -> [Char] -> [Char]
fromChoiceString ChoiceString
s
fromChoiceString (External ChoiceString
x) = case ChoiceString
x of
    -- Check that the sequence "</" is *not* in the external data.
    String [Char]
s     -> if [Char]
"</" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [Char]
s then forall a. a -> a
id else ([Char]
s forall a. [a] -> [a] -> [a]
++)
    Text   Text
s     -> if Text
"</" Text -> Text -> Bool
`T.isInfixOf` Text
s then forall a. a -> a
id else (\[Char]
k -> forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr (:) [Char]
k Text
s)
    ByteString ByteString
s -> if ByteString
"</" ByteString -> ByteString -> Bool
`S.isInfixOf` ByteString
s then forall a. a -> a
id else (ByteString -> [Char]
SBC.unpack ByteString
s forall a. [a] -> [a] -> [a]
++)
    ChoiceString
s            -> ChoiceString -> [Char] -> [Char]
fromChoiceString ChoiceString
s
fromChoiceString (AppendChoiceString ChoiceString
x ChoiceString
y) =
    ChoiceString -> [Char] -> [Char]
fromChoiceString ChoiceString
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> [Char] -> [Char]
fromChoiceString ChoiceString
y
fromChoiceString ChoiceString
EmptyChoiceString = forall a. a -> a
id
{-# INLINE fromChoiceString #-}

-- | Render some 'Markup' to an appending 'String'.
--
renderString :: Markup    -- ^ Markup to render
             -> String  -- ^ String to append
             -> String  -- ^ Resulting String
renderString :: Markup -> [Char] -> [Char]
renderString = forall b. ([Char] -> [Char]) -> MarkupM b -> [Char] -> [Char]
go forall a. a -> a
id
  where
    go :: (String -> String) -> MarkupM b -> String -> String
    go :: forall b. ([Char] -> [Char]) -> MarkupM b -> [Char] -> [Char]
go [Char] -> [Char]
attrs (Parent StaticString
_ StaticString
open StaticString
close MarkupM b
content) =
        StaticString -> [Char] -> [Char]
getString StaticString
open forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
attrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'>' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. ([Char] -> [Char]) -> MarkupM b -> [Char] -> [Char]
go forall a. a -> a
id MarkupM b
content forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticString -> [Char] -> [Char]
getString StaticString
close
    go [Char] -> [Char]
attrs (CustomParent ChoiceString
tag MarkupM b
content) =
        (Char
'<' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> [Char] -> [Char]
fromChoiceString ChoiceString
tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
attrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'>' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall b. ([Char] -> [Char]) -> MarkupM b -> [Char] -> [Char]
go forall a. a -> a
id MarkupM b
content forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        ([Char]
"</" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> [Char] -> [Char]
fromChoiceString ChoiceString
tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'>' forall a. a -> [a] -> [a]
:)
    go [Char] -> [Char]
attrs (Leaf StaticString
_ StaticString
begin StaticString
end b
_) = StaticString -> [Char] -> [Char]
getString StaticString
begin forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
attrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticString -> [Char] -> [Char]
getString StaticString
end
    go [Char] -> [Char]
attrs (CustomLeaf ChoiceString
tag Bool
close b
_) =
        (Char
'<' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> [Char] -> [Char]
fromChoiceString ChoiceString
tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
attrs forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (if Bool
close then ([Char]
" />" forall a. [a] -> [a] -> [a]
++) else (Char
'>' forall a. a -> [a] -> [a]
:))
    go [Char] -> [Char]
attrs (AddAttribute StaticString
_ StaticString
key ChoiceString
value MarkupM b
h) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b. ([Char] -> [Char]) -> MarkupM b -> [Char] -> [Char]
go MarkupM b
h forall a b. (a -> b) -> a -> b
$
        StaticString -> [Char] -> [Char]
getString StaticString
key forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> [Char] -> [Char]
fromChoiceString ChoiceString
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'"' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
attrs
    go [Char] -> [Char]
attrs (AddCustomAttribute ChoiceString
key ChoiceString
value MarkupM b
h) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b. ([Char] -> [Char]) -> MarkupM b -> [Char] -> [Char]
go MarkupM b
h forall a b. (a -> b) -> a -> b
$
        (Char
' ' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> [Char] -> [Char]
fromChoiceString ChoiceString
key forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"=\"" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> [Char] -> [Char]
fromChoiceString ChoiceString
value forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (Char
'"' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
.  [Char] -> [Char]
attrs
    go [Char] -> [Char]
_ (Content ChoiceString
content b
_) = ChoiceString -> [Char] -> [Char]
fromChoiceString ChoiceString
content
    go [Char] -> [Char]
_ (Comment ChoiceString
comment b
_) =
        ([Char]
"<!-- " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> [Char] -> [Char]
fromChoiceString ChoiceString
comment forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
" -->" forall a. [a] -> [a] -> [a]
++)
    go [Char] -> [Char]
attrs (Append MarkupM b
h1 MarkupM b
h2) = forall b. ([Char] -> [Char]) -> MarkupM b -> [Char] -> [Char]
go [Char] -> [Char]
attrs MarkupM b
h1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. ([Char] -> [Char]) -> MarkupM b -> [Char] -> [Char]
go [Char] -> [Char]
attrs MarkupM b
h2
    go [Char] -> [Char]
_ (Empty b
_) = forall a. a -> a
id
    {-# NOINLINE go #-}
{-# INLINE renderString #-}

-- | Render markup to a lazy 'String'.
--
renderMarkup :: Markup -> String
renderMarkup :: Markup -> [Char]
renderMarkup Markup
html = Markup -> [Char] -> [Char]
renderString Markup
html [Char]
""
{-# INLINE renderMarkup #-}

renderHtml :: Markup -> String
renderHtml :: Markup -> [Char]
renderHtml = Markup -> [Char]
renderMarkup
{-# INLINE renderHtml #-}
{-# DEPRECATED renderHtml
    "Use renderHtml from Text.Blaze.Html.Renderer.String instead" #-}