{-# 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
Prelude.concatMap [HtmlEntity] -> [Text]
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 Text
_) (HtmlEndTag HtmlTagStack
stck' HtmlTag
tg') =
        HtmlTag -> HtmlTagKind
htmlTagKind HtmlTag
tg forall a. Eq a => a -> a -> Bool
== HtmlTagKind
Void Bool -> Bool -> Bool
&& HtmlTagStack
stck forall a. Eq a => a -> a -> Bool
== HtmlTagStack
stck' Bool -> Bool -> Bool
&& HtmlTag
tg 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 -> Text
rawAttributes = Text
at }, b :: HtmlEntity
b@HtmlEndTag {}] =
        if HtmlEntity -> HtmlEntity -> Bool
isVoid HtmlEntity
a HtmlEntity
b
        then
            [ Text
"<"
            , Text -> Text
fromStrict (HtmlTag -> Text
htmlTagName HtmlTag
t)
            , Text -> Text
renderAttrs Text
at
            , if Bool
xhtml then Text
"/>" else Text
">"
            ]
        else HtmlEntity -> [Text]
e HtmlEntity
a forall a. [a] -> [a] -> [a]
++ HtmlEntity -> [Text]
e HtmlEntity
b
    render [HtmlEntity]
entities = 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 -> Text
rawAttributes = Text
a } =
        [Text
"<", Text -> Text
fromStrict (HtmlTag -> Text
htmlTagName HtmlTag
t), Text -> Text
renderAttrs Text
a, Text
">"]
    e HtmlEndTag { tag :: HtmlEntity -> HtmlTag
tag = HtmlTag
t } = [Text
"</", Text -> Text
fromStrict (HtmlTag -> Text
htmlTagName HtmlTag
t), Text
">"]
    e HtmlText { rawText :: HtmlEntity -> Text
rawText = Text
t } = [Text -> Text
fromStrict Text
t]
    e HtmlCdata { text :: HtmlEntity -> Text
text = Text
t } = [Text
"<![CDATA[", Text -> Text
fromStrict Text
t, Text
"]]>"]
    e HtmlComment { comment :: HtmlEntity -> Text
comment = Text
c } = [Text
"<!--", Text -> Text
fromStrict Text
c, Text
"-->"]
    renderAttrs :: Data.Text.Text -> Text
    renderAttrs :: Text -> Text
renderAttrs Text
"" = Text
""
    renderAttrs Text
attrs
      | Char -> Bool
isSpace (Text -> Char
Data.Text.head Text
attrs) = Text -> Text
fromStrict Text
attrs
      | Bool
otherwise = Char
' ' Char -> Text -> Text
`cons` Text -> Text
fromStrict Text
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 forall a. Semigroup a => a -> a -> a
<> [HtmlEntity] -> Text
printText [HtmlEntity]
xs
  where
    render :: HtmlEntity -> Text
    render :: HtmlEntity -> Text
render = \ case
        HtmlText { rawText :: HtmlEntity -> Text
rawText = Text
t } -> Builder -> Text
toLazyText forall a b. (a -> b) -> a -> b
$ Text -> Builder
htmlEncodedText Text
t
        HtmlCdata { text :: HtmlEntity -> Text
text = Text
t } -> Text -> Text
fromStrict Text
t
        HtmlEntity
_ -> Text
Data.Text.Lazy.empty