{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Seonbi.Html.Printer
( printHtml
, printText
, printXhtml
) where
import Data.Char
import Data.List
import qualified Data.Text
import Data.Text.Lazy
import Data.Text.Lazy.Builder
import HTMLEntities.Decoder
import Text.Seonbi.Html.Entity
import Text.Seonbi.Html.Tag
printHtml :: [HtmlEntity] -> Text
printHtml :: [HtmlEntity] -> Text
printHtml = Bool -> [HtmlEntity] -> Text
printHtml' Bool
False
printXhtml :: [HtmlEntity] -> Text
printXhtml :: [HtmlEntity] -> Text
printXhtml = Bool -> [HtmlEntity] -> Text
printHtml' Bool
True
printHtml' :: Bool -> [HtmlEntity] -> Text
printHtml' :: Bool -> [HtmlEntity] -> Text
printHtml' Bool
xhtml =
[Text] -> Text
Data.Text.Lazy.concat ([Text] -> Text)
-> ([HtmlEntity] -> [Text]) -> [HtmlEntity] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([HtmlEntity] -> [Text]) -> [[HtmlEntity]] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
Prelude.concatMap [HtmlEntity] -> [Text]
render ([[HtmlEntity]] -> [Text])
-> ([HtmlEntity] -> [[HtmlEntity]]) -> [HtmlEntity] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HtmlEntity -> HtmlEntity -> Bool)
-> [HtmlEntity] -> [[HtmlEntity]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
Data.List.groupBy HtmlEntity -> HtmlEntity -> Bool
isVoid
where
isVoid :: HtmlEntity -> HtmlEntity -> Bool
isVoid :: HtmlEntity -> HtmlEntity -> Bool
isVoid (HtmlStartTag HtmlTagStack
stck HtmlTag
tg HtmlRawAttrs
_) (HtmlEndTag HtmlTagStack
stck' HtmlTag
tg') =
HtmlTag -> HtmlTagKind
htmlTagKind HtmlTag
tg HtmlTagKind -> HtmlTagKind -> Bool
forall a. Eq a => a -> a -> Bool
== HtmlTagKind
Void Bool -> Bool -> Bool
&& HtmlTagStack
stck HtmlTagStack -> HtmlTagStack -> Bool
forall a. Eq a => a -> a -> Bool
== HtmlTagStack
stck' Bool -> Bool -> Bool
&& HtmlTag
tg HtmlTag -> HtmlTag -> Bool
forall a. Eq a => a -> a -> Bool
== HtmlTag
tg'
isVoid HtmlEntity
_ HtmlEntity
_ = Bool
False
render :: [HtmlEntity] -> [Text]
render :: [HtmlEntity] -> [Text]
render [a :: HtmlEntity
a@HtmlStartTag { tag :: HtmlEntity -> HtmlTag
tag = HtmlTag
t, rawAttributes :: HtmlEntity -> HtmlRawAttrs
rawAttributes = HtmlRawAttrs
at }, b :: HtmlEntity
b@HtmlEndTag {}] =
if HtmlEntity -> HtmlEntity -> Bool
isVoid HtmlEntity
a HtmlEntity
b
then
[ Text
"<"
, HtmlRawAttrs -> Text
fromStrict (HtmlTag -> HtmlRawAttrs
htmlTagName HtmlTag
t)
, HtmlRawAttrs -> Text
renderAttrs HtmlRawAttrs
at
, if Bool
xhtml then Text
"/>" else Text
">"
]
else HtmlEntity -> [Text]
e HtmlEntity
a [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ HtmlEntity -> [Text]
e HtmlEntity
b
render [HtmlEntity]
entities = (HtmlEntity -> [Text]) -> [HtmlEntity] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
Prelude.concatMap HtmlEntity -> [Text]
e [HtmlEntity]
entities
e :: HtmlEntity -> [Text]
e :: HtmlEntity -> [Text]
e HtmlStartTag { tag :: HtmlEntity -> HtmlTag
tag = HtmlTag
t, rawAttributes :: HtmlEntity -> HtmlRawAttrs
rawAttributes = HtmlRawAttrs
a } =
[Text
"<", HtmlRawAttrs -> Text
fromStrict (HtmlTag -> HtmlRawAttrs
htmlTagName HtmlTag
t), HtmlRawAttrs -> Text
renderAttrs HtmlRawAttrs
a, Text
">"]
e HtmlEndTag { tag :: HtmlEntity -> HtmlTag
tag = HtmlTag
t } = [Text
"</", HtmlRawAttrs -> Text
fromStrict (HtmlTag -> HtmlRawAttrs
htmlTagName HtmlTag
t), Text
">"]
e HtmlText { rawText :: HtmlEntity -> HtmlRawAttrs
rawText = HtmlRawAttrs
t } = [HtmlRawAttrs -> Text
fromStrict HtmlRawAttrs
t]
e HtmlCdata { text :: HtmlEntity -> HtmlRawAttrs
text = HtmlRawAttrs
t } = [Text
"<![CDATA[", HtmlRawAttrs -> Text
fromStrict HtmlRawAttrs
t, Text
"]]>"]
e HtmlComment { comment :: HtmlEntity -> HtmlRawAttrs
comment = HtmlRawAttrs
c } = [Text
"<!--", HtmlRawAttrs -> Text
fromStrict HtmlRawAttrs
c, Text
"-->"]
renderAttrs :: Data.Text.Text -> Text
renderAttrs :: HtmlRawAttrs -> Text
renderAttrs HtmlRawAttrs
"" = Text
""
renderAttrs HtmlRawAttrs
attrs
| Char -> Bool
isSpace (HtmlRawAttrs -> Char
Data.Text.head HtmlRawAttrs
attrs) = HtmlRawAttrs -> Text
fromStrict HtmlRawAttrs
attrs
| Bool
otherwise = Char
' ' Char -> Text -> Text
`cons` HtmlRawAttrs -> Text
fromStrict HtmlRawAttrs
attrs
printText :: [HtmlEntity] -> Text
printText :: [HtmlEntity] -> Text
printText [] = Text
Data.Text.Lazy.empty
printText (HtmlEntity
x:[HtmlEntity]
xs) =
HtmlEntity -> Text
render HtmlEntity
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [HtmlEntity] -> Text
printText [HtmlEntity]
xs
where
render :: HtmlEntity -> Text
render :: HtmlEntity -> Text
render = \ case
HtmlText { rawText :: HtmlEntity -> HtmlRawAttrs
rawText = HtmlRawAttrs
t } -> Builder -> Text
toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ HtmlRawAttrs -> Builder
htmlEncodedText HtmlRawAttrs
t
HtmlCdata { text :: HtmlEntity -> HtmlRawAttrs
text = HtmlRawAttrs
t } -> HtmlRawAttrs -> Text
fromStrict HtmlRawAttrs
t
HtmlEntity
_ -> Text
Data.Text.Lazy.empty