{-# LANGUAGE PatternGuards, OverloadedStrings #-}
module Text.HTML.TagSoup.Render
(
renderTags, renderTagsOptions, escapeHTML,
RenderOptions(..), renderOptions
) where
import Text.HTML.TagSoup.Entity
import Text.HTML.TagSoup.Type
import Text.StringLike
data RenderOptions str = RenderOptions
{forall str. RenderOptions str -> str -> str
optEscape :: str -> str
,forall str. RenderOptions str -> str -> Bool
optMinimize :: str -> Bool
,forall str. RenderOptions str -> str -> Bool
optRawTag :: str -> Bool
}
escapeHTML :: StringLike str => str -> str
escapeHTML :: forall str. StringLike str => str -> str
escapeHTML = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
escapeXML forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StringLike a => a -> String
toString
renderOptions :: StringLike str => RenderOptions str
renderOptions :: forall str. StringLike str => RenderOptions str
renderOptions = forall str.
(str -> str) -> (str -> Bool) -> (str -> Bool) -> RenderOptions str
RenderOptions forall str. StringLike str => str -> str
escapeHTML (\str
x -> forall a. StringLike a => a -> String
toString str
x forall a. Eq a => a -> a -> Bool
== String
"br") (\str
x -> forall a. StringLike a => a -> String
toString str
x forall a. Eq a => a -> a -> Bool
== String
"script")
renderTags :: StringLike str => [Tag str] -> str
renderTags :: forall str. StringLike str => [Tag str] -> str
renderTags = forall str. StringLike str => RenderOptions str -> [Tag str] -> str
renderTagsOptions forall str. StringLike str => RenderOptions str
renderOptions
renderTagsOptions :: StringLike str => RenderOptions str -> [Tag str] -> str
renderTagsOptions :: forall str. StringLike str => RenderOptions str -> [Tag str] -> str
renderTagsOptions RenderOptions str
opts = forall a. StringLike a => [a] -> a
strConcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tag str] -> [str]
tags
where
ss :: a -> [a]
ss a
x = [a
x]
tags :: [Tag str] -> [str]
tags (TagOpen str
name [Attribute str]
atts:TagClose str
name2:[Tag str]
xs)
| str
name forall a. Eq a => a -> a -> Bool
== str
name2 Bool -> Bool -> Bool
&& forall str. RenderOptions str -> str -> Bool
optMinimize RenderOptions str
opts str
name = forall {t :: * -> *}.
Foldable t =>
str -> t (Attribute str) -> str -> [str]
open str
name [Attribute str]
atts str
" /" forall a. [a] -> [a] -> [a]
++ [Tag str] -> [str]
tags [Tag str]
xs
tags (TagOpen str
name [Attribute str]
atts:[Tag str]
xs)
| Just (Char
'?',str
_) <- forall a. StringLike a => a -> Maybe (Char, a)
uncons str
name = forall {t :: * -> *}.
Foldable t =>
str -> t (Attribute str) -> str -> [str]
open str
name [Attribute str]
atts str
" ?" forall a. [a] -> [a] -> [a]
++ [Tag str] -> [str]
tags [Tag str]
xs
| forall str. RenderOptions str -> str -> Bool
optRawTag RenderOptions str
opts str
name =
let ([Tag str]
a,[Tag str]
b) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== forall str. str -> Tag str
TagClose str
name) (forall str. str -> [Attribute str] -> Tag str
TagOpen str
name [Attribute str]
attsforall a. a -> [a] -> [a]
:[Tag str]
xs)
in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Tag str
x -> case Tag str
x of TagText str
s -> [str
s]; Tag str
_ -> Tag str -> [str]
tag Tag str
x) [Tag str]
a forall a. [a] -> [a] -> [a]
++ [Tag str] -> [str]
tags [Tag str]
b
tags (Tag str
x:[Tag str]
xs) = Tag str -> [str]
tag Tag str
x forall a. [a] -> [a] -> [a]
++ [Tag str] -> [str]
tags [Tag str]
xs
tags [] = []
tag :: Tag str -> [str]
tag (TagOpen str
name [Attribute str]
atts) = forall {t :: * -> *}.
Foldable t =>
str -> t (Attribute str) -> str -> [str]
open str
name [Attribute str]
atts str
""
tag (TagClose str
name) = [str
"</", str
name, str
">"]
tag (TagText str
text) = [str -> str
txt str
text]
tag (TagComment str
text) = forall {a}. a -> [a]
ss str
"<!--" forall a. [a] -> [a] -> [a]
++ forall {a} {a}. (StringLike a, StringLike a) => a -> [a]
com str
text forall a. [a] -> [a] -> [a]
++ forall {a}. a -> [a]
ss str
"-->"
tag Tag str
_ = forall {a}. a -> [a]
ss str
""
txt :: str -> str
txt = forall str. RenderOptions str -> str -> str
optEscape RenderOptions str
opts
open :: str -> t (Attribute str) -> str -> [str]
open str
name t (Attribute str)
atts str
shut = [str
"<",str
name] forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Attribute str -> [str]
att t (Attribute str)
atts forall a. [a] -> [a] -> [a]
++ [str
shut,str
">"]
att :: Attribute str -> [str]
att (str
"",str
"") = [str
" \"\""]
att (str
x ,str
"") = [str
" ", str
x]
att (str
"", str
y) = [str
" \"",str -> str
txt str
y,str
"\""]
att (str
x , str
y) = [str
" ",str
x,str
"=\"",str -> str
txt str
y,str
"\""]
com :: a -> [a]
com a
xs | Just (Char
'-',a
xs) <- forall a. StringLike a => a -> Maybe (Char, a)
uncons a
xs, Just (Char
'-',a
xs) <- forall a. StringLike a => a -> Maybe (Char, a)
uncons a
xs, Just (Char
'>',a
xs) <- forall a. StringLike a => a -> Maybe (Char, a)
uncons a
xs = a
"-- >" forall a. a -> [a] -> [a]
: a -> [a]
com a
xs
com a
xs = case forall a. StringLike a => a -> Maybe (Char, a)
uncons a
xs of
Maybe (Char, a)
Nothing -> []
Just (Char
x,a
xs) -> forall a. StringLike a => Char -> a
fromChar Char
x forall a. a -> [a] -> [a]
: a -> [a]
com a
xs