{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Defines the HTML render.
module Zenacy.HTML.Internal.Render
  ( htmlPrint
  , htmlPrintPretty
  , htmlRender
  , htmlRenderContent
  , htmlRenderNodes
  , htmlRenderPretty
  ) where

import Zenacy.HTML.Internal.Core
import Zenacy.HTML.Internal.HTML
import Zenacy.HTML.Internal.Oper
import Data.Monoid
  ( (<>)
  )
import Data.Text
  ( Text
  )
import qualified Data.Text as T
  ( append
  , concat
  , empty
  , intercalate
  , replace
  )
import qualified Data.Text.IO as T
  ( putStrLn
  )

-- | The rendering mode.
data HTMLRenderMode
  = HTMLRenderNormal
  | HTMLRenderPretty
    deriving (Int -> HTMLRenderMode -> ShowS
[HTMLRenderMode] -> ShowS
HTMLRenderMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HTMLRenderMode] -> ShowS
$cshowList :: [HTMLRenderMode] -> ShowS
show :: HTMLRenderMode -> String
$cshow :: HTMLRenderMode -> String
showsPrec :: Int -> HTMLRenderMode -> ShowS
$cshowsPrec :: Int -> HTMLRenderMode -> ShowS
Show, HTMLRenderMode -> HTMLRenderMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HTMLRenderMode -> HTMLRenderMode -> Bool
$c/= :: HTMLRenderMode -> HTMLRenderMode -> Bool
== :: HTMLRenderMode -> HTMLRenderMode -> Bool
$c== :: HTMLRenderMode -> HTMLRenderMode -> Bool
Eq, Eq HTMLRenderMode
HTMLRenderMode -> HTMLRenderMode -> Bool
HTMLRenderMode -> HTMLRenderMode -> Ordering
HTMLRenderMode -> HTMLRenderMode -> HTMLRenderMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HTMLRenderMode -> HTMLRenderMode -> HTMLRenderMode
$cmin :: HTMLRenderMode -> HTMLRenderMode -> HTMLRenderMode
max :: HTMLRenderMode -> HTMLRenderMode -> HTMLRenderMode
$cmax :: HTMLRenderMode -> HTMLRenderMode -> HTMLRenderMode
>= :: HTMLRenderMode -> HTMLRenderMode -> Bool
$c>= :: HTMLRenderMode -> HTMLRenderMode -> Bool
> :: HTMLRenderMode -> HTMLRenderMode -> Bool
$c> :: HTMLRenderMode -> HTMLRenderMode -> Bool
<= :: HTMLRenderMode -> HTMLRenderMode -> Bool
$c<= :: HTMLRenderMode -> HTMLRenderMode -> Bool
< :: HTMLRenderMode -> HTMLRenderMode -> Bool
$c< :: HTMLRenderMode -> HTMLRenderMode -> Bool
compare :: HTMLRenderMode -> HTMLRenderMode -> Ordering
$ccompare :: HTMLRenderMode -> HTMLRenderMode -> Ordering
Ord)

-- | Prints an HTML document.
htmlPrint :: HTMLNode -> IO ()
htmlPrint :: HTMLNode -> IO ()
htmlPrint = Text -> IO ()
T.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. HTMLNode -> Text
htmlRender

-- | Pretty prints an HTML document.
htmlPrintPretty :: HTMLNode -> IO ()
htmlPrintPretty :: HTMLNode -> IO ()
htmlPrintPretty = Text -> IO ()
T.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. HTMLNode -> Text
htmlRenderPretty

-- | Renders an HTML document.
htmlRender :: HTMLNode -> Text
htmlRender :: HTMLNode -> Text
htmlRender = HTMLRenderMode -> HTMLNode -> Text
renderModal HTMLRenderMode
HTMLRenderNormal

-- | Renders the contents of a node
htmlRenderContent :: HTMLNode -> Text
htmlRenderContent :: HTMLNode -> Text
htmlRenderContent = [HTMLNode] -> Text
htmlRenderNodes forall b c a. (b -> c) -> (a -> b) -> a -> c
. HTMLNode -> [HTMLNode]
htmlNodeContent

-- | Renders a list of nodes.
htmlRenderNodes :: [HTMLNode] -> Text
htmlRenderNodes :: [HTMLNode] -> Text
htmlRenderNodes = [Text] -> Text
T.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map HTMLNode -> Text
htmlRender

-- | Renders an HTML document using pretty printing.
htmlRenderPretty :: HTMLNode -> Text
htmlRenderPretty :: HTMLNode -> Text
htmlRenderPretty = HTMLRenderMode -> HTMLNode -> Text
renderModal HTMLRenderMode
HTMLRenderPretty

-- | Renders an HTML document with a styling mode.
renderModal :: HTMLRenderMode -> HTMLNode -> Text
renderModal :: HTMLRenderMode -> HTMLNode -> Text
renderModal HTMLRenderMode
m = Int -> Text -> HTMLNode -> Text
go Int
0 Text
""
  where
    go :: Int -> Text -> HTMLNode -> Text
go Int
level Text
parent HTMLNode
node =
      case HTMLNode
node of
        HTMLDocument Text
_ [HTMLNode]
c ->
          [Text] -> Text
join forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> HTMLNode -> Text
go Int
level Text
parent) [HTMLNode]
c
        HTMLDoctype Text
n Maybe Text
p Maybe Text
s ->
          Text
indent forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Maybe Text -> Text
renderDoctype Text
n Maybe Text
p Maybe Text
s
        HTMLFragment Text
n [HTMLNode]
c ->
          [Text] -> Text
join forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> HTMLNode -> Text
go Int
level Text
parent) [HTMLNode]
c
        HTMLElement Text
n HTMLNamespace
s [HTMLAttr]
a [HTMLNode]
c ->
          Text
indent
          forall a. Semigroup a => a -> a -> a
<> Text -> [HTMLAttr] -> Text
renderElemStart Text
n [HTMLAttr]
a
          forall a. Semigroup a => a -> a -> a
<> if forall {a}. (Eq a, IsString a) => a -> Bool
voidTag Text
n
             then Text
T.empty
             else (if | forall {a}. (Eq a, IsString a) => a -> [HTMLNode] -> Bool
genLF Text
n [HTMLNode]
c -> Text
"\n"
                      | [HTMLNode] -> Bool
oneLine [HTMLNode]
c -> Text
T.empty
                      | Bool
otherwise -> Text
sep)
                  forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text
join forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> HTMLNode -> Text
go (if [HTMLNode] -> Bool
oneLine [HTMLNode]
c then Int
0 else Int
level') Text
n) [HTMLNode]
c)
                  forall a. Semigroup a => a -> a -> a
<> (if | [HTMLNode] -> Bool
oneLine [HTMLNode]
c -> Text
T.empty
                         | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HTMLNode]
c -> Text
indent
                         | Bool
otherwise -> Text
sep forall a. Semigroup a => a -> a -> a
<> Text
indent)
                  forall a. Semigroup a => a -> a -> a
<> Text -> Text
renderElemEnd Text
n
        HTMLTemplate HTMLNamespace
s [HTMLAttr]
a HTMLNode
c ->
          Text
indent forall a. Semigroup a => a -> a -> a
<> Text -> [HTMLAttr] -> Text
renderElemStart Text
tmp [HTMLAttr]
a
          forall a. Semigroup a => a -> a -> a
<> Text
sep forall a. Semigroup a => a -> a -> a
<> Int -> Text -> HTMLNode -> Text
go Int
level' Text
tmp HTMLNode
c
          forall a. Semigroup a => a -> a -> a
<> Text
sep forall a. Semigroup a => a -> a -> a
<> Text
indent forall a. Semigroup a => a -> a -> a
<> Text -> Text
renderElemEnd Text
tmp
        HTMLText Text
t ->
          Text
indent forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
renderText Text
t Text
parent
        HTMLComment Text
c ->
          Text
indent forall a. Semigroup a => a -> a -> a
<> Text -> Text
renderComment Text
c
      where
        level' :: Int
level' = Int
level forall a. Num a => a -> a -> a
+ Int
1
        join :: [Text] -> Text
join = Text -> [Text] -> Text
T.intercalate Text
sep
        indent :: Text
indent = case HTMLRenderMode
m of
          HTMLRenderMode
HTMLRenderNormal -> Text
T.empty
          HTMLRenderMode
HTMLRenderPretty -> Int -> Text
textBlank Int
level
        sep :: Text
sep = case HTMLRenderMode
m of
          HTMLRenderMode
HTMLRenderNormal -> Text
T.empty
          HTMLRenderMode
HTMLRenderPretty -> Text
"\n"
        tmp :: Text
tmp = Text
"template"
        voidTag :: a -> Bool
voidTag a
x = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
x
          [a
"area", a
"base", a
"basefont", a
"bgsound", a
"br", a
"col",
           a
"embed", a
"frame", a
"hr", a
"img", a
"input", a
"keygen",
           a
"link", a
"meta", a
"param", a
"source", a
"track", a
"wbr"]
        genLF :: a -> [HTMLNode] -> Bool
genLF a
x [HTMLNode]
c = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
x [a
"pre", a
"textarea", a
"listing"] Bool -> Bool -> Bool
&& [HTMLNode] -> Bool
oneText [HTMLNode]
c
        oneText :: [HTMLNode] -> Bool
oneText (HTMLText {}:[]) = Bool
True
        oneText [HTMLNode]
_ = Bool
False
        oneLine :: [HTMLNode] -> Bool
oneLine [HTMLNode]
x = [HTMLNode] -> Bool
oneText [HTMLNode]
x Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HTMLNode]
x

-- | Renders text for a doctype.
renderDoctype :: Text -> Maybe Text -> Maybe Text -> Text
renderDoctype :: Text -> Maybe Text -> Maybe Text -> Text
renderDoctype Text
x Maybe Text
y Maybe Text
z = Text
"<!DOCTYPE " forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Text
f Maybe Text
y forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Text
f Maybe Text
z forall a. Semigroup a => a -> a -> a
<> Text
">"
  where
    f :: Maybe Text -> Text
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
T.append Text
" ")

-- | Returns text for an attribute.
renderAttr :: HTMLAttr -> Text
renderAttr :: HTMLAttr -> Text
renderAttr (HTMLAttr Text
n Text
v HTMLAttrNamespace
s) =
  Text
" " forall a. Semigroup a => a -> a -> a
<> Text
n' forall a. Semigroup a => a -> a -> a
<> Text
"=\"" forall a. Semigroup a => a -> a -> a
<> Bool -> Text -> Text
escapeString Bool
True Text
v forall a. Semigroup a => a -> a -> a
<> Text
"\""
  where
    n' :: Text
n' = case HTMLAttrNamespace
s of
      HTMLAttrNamespace
HTMLAttrNamespaceNone -> Text
n
      HTMLAttrNamespace
HTMLAttrNamespaceXLink -> Text
"xlink:" forall a. Semigroup a => a -> a -> a
<> Text
n
      HTMLAttrNamespace
HTMLAttrNamespaceXML -> Text
"xml:" forall a. Semigroup a => a -> a -> a
<> Text
n
      HTMLAttrNamespace
HTMLAttrNamespaceXMLNS ->
        if Text
n forall a. Eq a => a -> a -> Bool
== Text
"xmlns" then Text
n else Text
"xmlns:" forall a. Semigroup a => a -> a -> a
<> Text
n

-- | Returns text for a list of attributes.
renderAttrList :: [HTMLAttr] -> Text
renderAttrList :: [HTMLAttr] -> Text
renderAttrList = [Text] -> Text
T.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map HTMLAttr -> Text
renderAttr

-- | Returns text for a start element.
renderElemStart :: Text -> [HTMLAttr] -> Text
renderElemStart :: Text -> [HTMLAttr] -> Text
renderElemStart Text
x [HTMLAttr]
y = Text
"<" forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> [HTMLAttr] -> Text
renderAttrList [HTMLAttr]
y forall a. Semigroup a => a -> a -> a
<> Text
">"

-- | Returns text for an end element.
renderElemEnd :: Text -> Text
renderElemEnd :: Text -> Text
renderElemEnd Text
x = Text
"</" forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> Text
">"

-- | Renders a text value.
renderText :: Text -> Text -> Text
renderText :: Text -> Text -> Text
renderText Text
x Text
parent =
  if Text
parent forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
a then Text
x else Bool -> Text -> Text
escapeString Bool
False Text
x
  where a :: [Text]
a = [Text
"style", Text
"script", Text
"xmp", Text
"iframe",
             Text
"noembed", Text
"noframes", Text
"plaintext"]

-- | Renders text for a comment element.
renderComment :: Text -> Text
renderComment :: Text -> Text
renderComment Text
x = Text
"<!--" forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> Text
"-->"

-- | Escapes a string for serialization.
escapeString :: Bool -> Text -> Text
escapeString :: Bool -> Text -> Text
escapeString Bool
attributeMode =
  Text -> Text
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"\x00A0"  Text
"&nbsp;"
    -- . T.replace "&" "&amp;" -- TODO: consider if this is needed
  where
    f :: Text -> Text
f = if Bool
attributeMode
        then Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"&quot;"
        else Text -> Text -> Text -> Text
T.replace Text
">" Text
"&gt;"
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"<" Text
"&lt;"