{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
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
)
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)
htmlPrint :: HTMLNode -> IO ()
htmlPrint :: HTMLNode -> IO ()
htmlPrint = Text -> IO ()
T.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. HTMLNode -> Text
htmlRender
htmlPrintPretty :: HTMLNode -> IO ()
htmlPrintPretty :: HTMLNode -> IO ()
htmlPrintPretty = Text -> IO ()
T.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. HTMLNode -> Text
htmlRenderPretty
htmlRender :: HTMLNode -> Text
htmlRender :: HTMLNode -> Text
htmlRender = HTMLRenderMode -> HTMLNode -> Text
renderModal HTMLRenderMode
HTMLRenderNormal
htmlRenderContent :: HTMLNode -> Text
htmlRenderContent :: HTMLNode -> Text
htmlRenderContent = [HTMLNode] -> Text
htmlRenderNodes forall b c a. (b -> c) -> (a -> b) -> a -> c
. HTMLNode -> [HTMLNode]
htmlNodeContent
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
htmlRenderPretty :: HTMLNode -> Text
htmlRenderPretty :: HTMLNode -> Text
htmlRenderPretty = HTMLRenderMode -> HTMLNode -> Text
renderModal HTMLRenderMode
HTMLRenderPretty
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
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
" ")
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
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
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
">"
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
">"
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"]
renderComment :: Text -> Text
Text
x = Text
"<!--" forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> Text
"-->"
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
" "
where
f :: Text -> Text
f = if Bool
attributeMode
then Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"""
else Text -> Text -> Text -> Text
T.replace Text
">" Text
">"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"<" Text
"<"