-- | 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 :: String -> String -> String
escapeMarkupEntities []     String
k = String
k
escapeMarkupEntities (Char
c:String
cs) String
k = case Char
c of
    Char
'<'  -> Char
'&' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'l' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
't' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
';'             Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String -> String
escapeMarkupEntities String
cs String
k
    Char
'>'  -> Char
'&' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'g' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
't' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
';'             Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String -> String
escapeMarkupEntities String
cs String
k
    Char
'&'  -> Char
'&' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'a' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'm' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'p' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
';'       Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String -> String
escapeMarkupEntities String
cs String
k
    Char
'"'  -> Char
'&' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'q' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'u' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'o' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
't' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
';' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String -> String
escapeMarkupEntities String
cs String
k
    Char
'\'' -> Char
'&' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'#' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'3' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'9' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
';'       Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String -> String
escapeMarkupEntities String
cs String
k
    Char
x    -> Char
x                                 Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String -> String
escapeMarkupEntities String
cs String
k

-- | Render a 'ChoiceString'.
--
fromChoiceString :: ChoiceString  -- ^ String to render
                 -> String        -- ^ String to append
                 -> String        -- ^ Resulting string
fromChoiceString :: ChoiceString -> String -> String
fromChoiceString (Static StaticString
s)     = StaticString -> String -> String
getString StaticString
s
fromChoiceString (String String
s)     = String -> String -> String
escapeMarkupEntities String
s
fromChoiceString (Text Text
s)       = String -> String -> String
escapeMarkupEntities (String -> String -> String) -> String -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s
fromChoiceString (ByteString ByteString
s) = (ByteString -> String
SBC.unpack ByteString
s String -> String -> String
forall a. [a] -> [a] -> [a]
++)
fromChoiceString (PreEscaped ChoiceString
x) = case ChoiceString
x of
    String String
s -> (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    Text   Text
s -> (\String
k -> (Char -> String -> String) -> String -> Text -> String
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr (:) String
k Text
s)
    ChoiceString
s        -> ChoiceString -> String -> String
fromChoiceString ChoiceString
s
fromChoiceString (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 String -> String
forall a. a -> a
id else (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    Text   Text
s     -> if Text
"</" Text -> Text -> Bool
`T.isInfixOf` Text
s then String -> String
forall a. a -> a
id else (\String
k -> (Char -> String -> String) -> String -> Text -> String
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr (:) String
k Text
s)
    ByteString ByteString
s -> if ByteString
"</" ByteString -> ByteString -> Bool
`S.isInfixOf` ByteString
s then String -> String
forall a. a -> a
id else (ByteString -> String
SBC.unpack ByteString
s String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    ChoiceString
s            -> ChoiceString -> String -> String
fromChoiceString ChoiceString
s
fromChoiceString (AppendChoiceString ChoiceString
x ChoiceString
y) =
    ChoiceString -> String -> String
fromChoiceString ChoiceString
x (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> String -> String
fromChoiceString ChoiceString
y
fromChoiceString ChoiceString
EmptyChoiceString = String -> String
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 -> String -> String
renderString = (String -> String) -> Markup -> String -> String
forall b. (String -> String) -> MarkupM b -> String -> String
go String -> String
forall a. a -> a
id
  where
    go :: (String -> String) -> MarkupM b -> String -> String
    go :: (String -> String) -> MarkupM b -> String -> String
go String -> String
attrs (Parent StaticString
_ StaticString
open StaticString
close MarkupM b
content) =
        StaticString -> String -> String
getString StaticString
open (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
attrs (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'>' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> MarkupM b -> String -> String
forall b. (String -> String) -> MarkupM b -> String -> String
go String -> String
forall a. a -> a
id MarkupM b
content (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticString -> String -> String
getString StaticString
close
    go String -> String
attrs (CustomParent ChoiceString
tag MarkupM b
content) =
        (Char
'<' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> String -> String
fromChoiceString ChoiceString
tag (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
attrs (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'>' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (String -> String) -> MarkupM b -> String -> String
forall b. (String -> String) -> MarkupM b -> String -> String
go String -> String
forall a. a -> a
id MarkupM b
content (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (String
"</" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> String -> String
fromChoiceString ChoiceString
tag (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'>' Char -> String -> String
forall a. a -> [a] -> [a]
:)
    go String -> String
attrs (Leaf StaticString
_ StaticString
begin StaticString
end b
_) = StaticString -> String -> String
getString StaticString
begin (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
attrs (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticString -> String -> String
getString StaticString
end
    go String -> String
attrs (CustomLeaf ChoiceString
tag Bool
close b
_) =
        (Char
'<' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> String -> String
fromChoiceString ChoiceString
tag (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
attrs (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (if Bool
close then (String
" />" String -> String -> String
forall a. [a] -> [a] -> [a]
++) else (Char
'>' Char -> String -> String
forall a. a -> [a] -> [a]
:))
    go String -> String
attrs (AddAttribute StaticString
_ StaticString
key ChoiceString
value MarkupM b
h) = ((String -> String) -> MarkupM b -> String -> String)
-> MarkupM b -> (String -> String) -> String -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> String) -> MarkupM b -> String -> String
forall b. (String -> String) -> MarkupM b -> String -> String
go MarkupM b
h ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
        StaticString -> String -> String
getString StaticString
key (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> String -> String
fromChoiceString ChoiceString
value (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
attrs
    go String -> String
attrs (AddCustomAttribute ChoiceString
key ChoiceString
value MarkupM b
h) = ((String -> String) -> MarkupM b -> String -> String)
-> MarkupM b -> (String -> String) -> String -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> String) -> MarkupM b -> String -> String
forall b. (String -> String) -> MarkupM b -> String -> String
go MarkupM b
h ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
        (Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> String -> String
fromChoiceString ChoiceString
key (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"=\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> String -> String
fromChoiceString ChoiceString
value (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  String -> String
attrs
    go String -> String
_ (Content ChoiceString
content b
_) = ChoiceString -> String -> String
fromChoiceString ChoiceString
content
    go String -> String
_ (Comment ChoiceString
comment b
_) =
        (String
"<!-- " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> String -> String
fromChoiceString ChoiceString
comment (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
" -->" String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    go String -> String
attrs (Append MarkupM b
h1 MarkupM b
h2) = (String -> String) -> MarkupM b -> String -> String
forall b. (String -> String) -> MarkupM b -> String -> String
go String -> String
attrs MarkupM b
h1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> MarkupM b -> String -> String
forall b. (String -> String) -> MarkupM b -> String -> String
go String -> String
attrs MarkupM b
h2
    go String -> String
_ (Empty b
_) = String -> String
forall a. a -> a
id
    {-# NOINLINE go #-}
{-# INLINE renderString #-}

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

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