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