{-# 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
escapeMarkupEntities :: String
-> String
-> String
escapeMarkupEntities :: String -> String -> String
escapeMarkupEntities [] k :: String
k = String
k
escapeMarkupEntities (c :: Char
c:cs :: String
cs) k :: String
k = case Char
c of
'<' -> '&' Char -> String -> String
forall a. a -> [a] -> [a]
: 'l' Char -> String -> String
forall a. a -> [a] -> [a]
: 't' Char -> String -> String
forall a. a -> [a] -> [a]
: ';' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String -> String
escapeMarkupEntities String
cs String
k
'>' -> '&' Char -> String -> String
forall a. a -> [a] -> [a]
: 'g' Char -> String -> String
forall a. a -> [a] -> [a]
: 't' Char -> String -> String
forall a. a -> [a] -> [a]
: ';' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String -> String
escapeMarkupEntities String
cs String
k
'&' -> '&' Char -> String -> String
forall a. a -> [a] -> [a]
: 'a' Char -> String -> String
forall a. a -> [a] -> [a]
: 'm' Char -> String -> String
forall a. a -> [a] -> [a]
: 'p' Char -> String -> String
forall a. a -> [a] -> [a]
: ';' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String -> String
escapeMarkupEntities String
cs String
k
'"' -> '&' Char -> String -> String
forall a. a -> [a] -> [a]
: 'q' Char -> String -> String
forall a. a -> [a] -> [a]
: 'u' Char -> String -> String
forall a. a -> [a] -> [a]
: 'o' Char -> String -> String
forall a. a -> [a] -> [a]
: 't' Char -> String -> String
forall a. a -> [a] -> [a]
: ';' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String -> String
escapeMarkupEntities String
cs String
k
'\'' -> '&' Char -> String -> String
forall a. a -> [a] -> [a]
: '#' Char -> String -> String
forall a. a -> [a] -> [a]
: '3' Char -> String -> String
forall a. a -> [a] -> [a]
: '9' Char -> String -> String
forall a. a -> [a] -> [a]
: ';' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String -> String
escapeMarkupEntities String
cs String
k
x :: Char
x -> Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String -> String
escapeMarkupEntities String
cs String
k
fromChoiceString :: ChoiceString
-> String
-> String
fromChoiceString :: ChoiceString -> String -> String
fromChoiceString (Static s :: StaticString
s) = StaticString -> String -> String
getString StaticString
s
fromChoiceString (String s :: String
s) = String -> String -> String
escapeMarkupEntities String
s
fromChoiceString (Text s :: 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 s :: ByteString
s) = (ByteString -> String
SBC.unpack ByteString
s String -> String -> String
forall a. [a] -> [a] -> [a]
++)
fromChoiceString (PreEscaped x :: ChoiceString
x) = case ChoiceString
x of
String s :: String
s -> (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++)
Text s :: Text
s -> (\k :: String
k -> (Char -> String -> String) -> String -> Text -> String
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr (:) String
k Text
s)
s :: ChoiceString
s -> ChoiceString -> String -> String
fromChoiceString ChoiceString
s
fromChoiceString (External x :: ChoiceString
x) = case ChoiceString
x of
String s :: String
s -> if "</" 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 s :: Text
s -> if "</" Text -> Text -> Bool
`T.isInfixOf` Text
s then String -> String
forall a. a -> a
id else (\k :: String
k -> (Char -> String -> String) -> String -> Text -> String
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr (:) String
k Text
s)
ByteString s :: ByteString
s -> if "</" 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]
++)
s :: ChoiceString
s -> ChoiceString -> String -> String
fromChoiceString ChoiceString
s
fromChoiceString (AppendChoiceString x :: ChoiceString
x y :: 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 EmptyChoiceString = String -> String
forall a. a -> a
id
{-# INLINE fromChoiceString #-}
renderString :: Markup
-> String
-> 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 attrs :: String -> String
attrs (Parent _ open :: StaticString
open close :: StaticString
close content :: 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 -> 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 attrs :: String -> String
attrs (CustomParent tag :: ChoiceString
tag content :: MarkupM b
content) =
('<' 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 -> 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
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 -> String -> String
forall a. a -> [a] -> [a]
:)
go attrs :: String -> String
attrs (Leaf _ begin :: StaticString
begin end :: StaticString
end _) = 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 attrs :: String -> String
attrs (CustomLeaf tag :: ChoiceString
tag close :: Bool
close _) =
('<' 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
forall a. [a] -> [a] -> [a]
++) else ('>' Char -> String -> String
forall a. a -> [a] -> [a]
:))
go attrs :: String -> String
attrs (AddAttribute _ key :: StaticString
key value :: ChoiceString
value h :: 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 -> 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 attrs :: String -> String
attrs (AddCustomAttribute key :: ChoiceString
key value :: ChoiceString
value h :: 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 -> 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
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 -> 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 _ (Content content :: ChoiceString
content _) = ChoiceString -> String -> String
fromChoiceString ChoiceString
content
go _ (Comment comment :: ChoiceString
comment _) =
("<!-- " 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
forall a. [a] -> [a] -> [a]
++)
go attrs :: String -> String
attrs (Append h1 :: MarkupM b
h1 h2 :: 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 _ (Empty _) = String -> String
forall a. a -> a
id
{-# NOINLINE go #-}
{-# INLINE renderString #-}
renderMarkup :: Markup -> String
renderMarkup :: Markup -> String
renderMarkup html :: Markup
html = Markup -> String -> String
renderString Markup
html ""
{-# 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" #-}