{-# LANGUAGE OverloadedStrings #-}
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
escapeMarkupEntities :: 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
"<" Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
escape Char
'>' Builder
b = Text -> Builder
B.fromText Text
">" Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
escape Char
'&' Builder
b = Text -> Builder
B.fromText Text
"&" Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
escape Char
'"' Builder
b = Text -> Builder
B.fromText Text
""" Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
escape Char
'\'' Builder
b = Text -> Builder
B.fromText Text
"'" 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
fromChoiceString :: (ByteString -> Text)
-> ChoiceString
-> 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
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 #-}
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" #-}
renderMarkupBuilderWith :: (ByteString -> Text)
-> Markup
-> 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)
-> Markup
-> 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" #-}
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" #-}
renderMarkupWith :: (ByteString -> Text)
-> Markup
-> L.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)
-> Markup
-> L.Text
renderHtmlWith :: (ByteString -> Text) -> Markup -> Text
renderHtmlWith = (ByteString -> Text) -> Markup -> Text
renderMarkupWith
{-# DEPRECATED renderHtmlWith
"Use renderHtmlWith from Text.Blaze.Html.Renderer.Text instead" #-}