{-# 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

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Text.Seonbi.Html.Scanner
-- >>> :set -interactive-print=Text.Show.Unicode.uprint

-- | Print the list of 'HtmlEntity' into a lazy 'Text'.
--
-- >>> let Done "" tokens = scanHtml "<p>Hello,<br>\n<em>world</em>!</p>"
-- >>> printHtml tokens
-- "<p>Hello,<br>\n<em>world</em>!</p>"
printHtml :: [HtmlEntity] -> Text
printHtml :: [HtmlEntity] -> Text
printHtml = Bool -> [HtmlEntity] -> Text
printHtml' Bool
False

-- | Similar to 'printHtml' except it renders void (self-closing) tags as
-- like @<br/>@ instead of @<br>@.
--
-- >>> let Done "" tokens = scanHtml "<p>Hello,<br>\n<em>world</em>!</p>"
-- >>> printXhtml tokens
-- "<p>Hello,<br/>\n<em>world</em>!</p>"
--
-- Note that normal tags are not rendered as self-closed; only void tags
-- according to HTML specification are:
--
-- >>> let Done "" tokens' = scanHtml "<p></p><p><br></p>"
-- >>> printXhtml tokens'
-- "<p></p><p><br/></p>"
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

-- | Print only the text contents (including CDATA sections) without tags
-- into a lazy 'Text'.
--
-- >>> let Done "" tokens = scanHtml "<p>Hello,<br>\n<em>world</em>!</p>"
-- >>> printText tokens
-- "Hello,\nworld!"
--
-- Entities are decoded:
--
-- >>> let Done "" tokens = scanHtml "<p><code>&lt;&gt;&quot;&amp;</code></p>"
-- >>> printText tokens
-- "<>\"&"
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