module Text.HTML.TagSoup.Tree
(
TagTree(..), tagTree, parseTree, parseTreeOptions, ParseOptions(..),
flattenTree, renderTree, renderTreeOptions, RenderOptions(..), transformTree, universeTree
) where
import Text.HTML.TagSoup (parseTags, parseTagsOptions, renderTags, renderTagsOptions, ParseOptions(..), RenderOptions(..))
import Text.HTML.TagSoup.Type
import Control.Arrow
import GHC.Exts (build)
data TagTree str
=
TagBranch str [Attribute str] [TagTree str]
|
TagLeaf (Tag str)
deriving (TagTree str -> TagTree str -> Bool
forall str. Eq str => TagTree str -> TagTree str -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagTree str -> TagTree str -> Bool
$c/= :: forall str. Eq str => TagTree str -> TagTree str -> Bool
== :: TagTree str -> TagTree str -> Bool
$c== :: forall str. Eq str => TagTree str -> TagTree str -> Bool
Eq,TagTree str -> TagTree str -> Bool
TagTree str -> TagTree str -> Ordering
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
forall {str}. Ord str => Eq (TagTree str)
forall str. Ord str => TagTree str -> TagTree str -> Bool
forall str. Ord str => TagTree str -> TagTree str -> Ordering
forall str. Ord str => TagTree str -> TagTree str -> TagTree str
min :: TagTree str -> TagTree str -> TagTree str
$cmin :: forall str. Ord str => TagTree str -> TagTree str -> TagTree str
max :: TagTree str -> TagTree str -> TagTree str
$cmax :: forall str. Ord str => TagTree str -> TagTree str -> TagTree str
>= :: TagTree str -> TagTree str -> Bool
$c>= :: forall str. Ord str => TagTree str -> TagTree str -> Bool
> :: TagTree str -> TagTree str -> Bool
$c> :: forall str. Ord str => TagTree str -> TagTree str -> Bool
<= :: TagTree str -> TagTree str -> Bool
$c<= :: forall str. Ord str => TagTree str -> TagTree str -> Bool
< :: TagTree str -> TagTree str -> Bool
$c< :: forall str. Ord str => TagTree str -> TagTree str -> Bool
compare :: TagTree str -> TagTree str -> Ordering
$ccompare :: forall str. Ord str => TagTree str -> TagTree str -> Ordering
Ord,Int -> TagTree str -> ShowS
forall str. Show str => Int -> TagTree str -> ShowS
forall str. Show str => [TagTree str] -> ShowS
forall str. Show str => TagTree str -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagTree str] -> ShowS
$cshowList :: forall str. Show str => [TagTree str] -> ShowS
show :: TagTree str -> String
$cshow :: forall str. Show str => TagTree str -> String
showsPrec :: Int -> TagTree str -> ShowS
$cshowsPrec :: forall str. Show str => Int -> TagTree str -> ShowS
Show)
instance Functor TagTree where
fmap :: forall a b. (a -> b) -> TagTree a -> TagTree b
fmap a -> b
f (TagBranch a
x [Attribute a]
y [TagTree a]
z) = forall str. str -> [Attribute str] -> [TagTree str] -> TagTree str
TagBranch (a -> b
f a
x) (forall a b. (a -> b) -> [a] -> [b]
map (a -> b
fforall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
***a -> b
f) [Attribute a]
y) (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [TagTree a]
z)
fmap a -> b
f (TagLeaf Tag a
x) = forall str. Tag str -> TagTree str
TagLeaf (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Tag a
x)
tagTree :: Eq str => [Tag str] -> [TagTree str]
tagTree :: forall str. Eq str => [Tag str] -> [TagTree str]
tagTree = forall str. Eq str => [Tag str] -> [TagTree str]
g
where
g :: Eq str => [Tag str] -> [TagTree str]
g :: forall str. Eq str => [Tag str] -> [TagTree str]
g [] = []
g [Tag str]
xs = [TagTree str]
a forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall str. Tag str -> TagTree str
TagLeaf (forall a. Int -> [a] -> [a]
take Int
1 [Tag str]
b) forall a. [a] -> [a] -> [a]
++ forall str. Eq str => [Tag str] -> [TagTree str]
g (forall a. Int -> [a] -> [a]
drop Int
1 [Tag str]
b)
where ([TagTree str]
a,[Tag str]
b) = forall str. Eq str => [Tag str] -> ([TagTree str], [Tag str])
f [Tag str]
xs
f :: Eq str => [Tag str] -> ([TagTree str],[Tag str])
f :: forall str. Eq str => [Tag str] -> ([TagTree str], [Tag str])
f (TagOpen str
name [Attribute str]
atts:[Tag str]
rest) =
case forall str. Eq str => [Tag str] -> ([TagTree str], [Tag str])
f [Tag str]
rest of
([TagTree str]
inner,[]) -> (forall str. Tag str -> TagTree str
TagLeaf (forall str. str -> [Attribute str] -> Tag str
TagOpen str
name [Attribute str]
atts)forall a. a -> [a] -> [a]
:[TagTree str]
inner, [])
([TagTree str]
inner,TagClose str
x:[Tag str]
xs)
| str
x forall a. Eq a => a -> a -> Bool
== str
name -> let ([TagTree str]
a,[Tag str]
b) = forall str. Eq str => [Tag str] -> ([TagTree str], [Tag str])
f [Tag str]
xs in (forall str. str -> [Attribute str] -> [TagTree str] -> TagTree str
TagBranch str
name [Attribute str]
atts [TagTree str]
innerforall a. a -> [a] -> [a]
:[TagTree str]
a, [Tag str]
b)
| Bool
otherwise -> (forall str. Tag str -> TagTree str
TagLeaf (forall str. str -> [Attribute str] -> Tag str
TagOpen str
name [Attribute str]
atts)forall a. a -> [a] -> [a]
:[TagTree str]
inner, forall str. str -> Tag str
TagClose str
xforall a. a -> [a] -> [a]
:[Tag str]
xs)
([TagTree str], [Tag str])
_ -> forall a. HasCallStack => String -> a
error String
"TagSoup.Tree.tagTree: safe as - forall x . isTagClose (snd (f x))"
f (TagClose str
x:[Tag str]
xs) = ([], forall str. str -> Tag str
TagClose str
xforall a. a -> [a] -> [a]
:[Tag str]
xs)
f (Tag str
x:[Tag str]
xs) = (forall str. Tag str -> TagTree str
TagLeaf Tag str
xforall a. a -> [a] -> [a]
:[TagTree str]
a,[Tag str]
b)
where ([TagTree str]
a,[Tag str]
b) = forall str. Eq str => [Tag str] -> ([TagTree str], [Tag str])
f [Tag str]
xs
f [] = ([], [])
parseTree :: StringLike str => str -> [TagTree str]
parseTree :: forall str. StringLike str => str -> [TagTree str]
parseTree = forall str. Eq str => [Tag str] -> [TagTree str]
tagTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall str. StringLike str => str -> [Tag str]
parseTags
parseTreeOptions :: StringLike str => ParseOptions str -> str -> [TagTree str]
parseTreeOptions :: forall str.
StringLike str =>
ParseOptions str -> str -> [TagTree str]
parseTreeOptions ParseOptions str
opts str
str = forall str. Eq str => [Tag str] -> [TagTree str]
tagTree forall a b. (a -> b) -> a -> b
$ forall str. StringLike str => ParseOptions str -> str -> [Tag str]
parseTagsOptions ParseOptions str
opts str
str
flattenTree :: [TagTree str] -> [Tag str]
flattenTree :: forall str. [TagTree str] -> [Tag str]
flattenTree [TagTree str]
xs = forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build forall a b. (a -> b) -> a -> b
$ forall str lst.
[TagTree str] -> (Tag str -> lst -> lst) -> lst -> lst
flattenTreeFB [TagTree str]
xs
flattenTreeFB :: [TagTree str] -> (Tag str -> lst -> lst) -> lst -> lst
flattenTreeFB :: forall str lst.
[TagTree str] -> (Tag str -> lst -> lst) -> lst -> lst
flattenTreeFB [TagTree str]
xs Tag str -> lst -> lst
cons lst
nil = [TagTree str] -> lst -> lst
flattenTreeOnto [TagTree str]
xs lst
nil
where
flattenTreeOnto :: [TagTree str] -> lst -> lst
flattenTreeOnto [] lst
tags = lst
tags
flattenTreeOnto (TagBranch str
name [Attribute str]
atts [TagTree str]
inner:[TagTree str]
trs) lst
tags =
forall str. str -> [Attribute str] -> Tag str
TagOpen str
name [Attribute str]
atts Tag str -> lst -> lst
`cons` [TagTree str] -> lst -> lst
flattenTreeOnto [TagTree str]
inner (forall str. str -> Tag str
TagClose str
name Tag str -> lst -> lst
`cons` [TagTree str] -> lst -> lst
flattenTreeOnto [TagTree str]
trs lst
tags)
flattenTreeOnto (TagLeaf Tag str
x:[TagTree str]
trs) lst
tags = Tag str
x Tag str -> lst -> lst
`cons` [TagTree str] -> lst -> lst
flattenTreeOnto [TagTree str]
trs lst
tags
renderTree :: StringLike str => [TagTree str] -> str
renderTree :: forall str. StringLike str => [TagTree str] -> str
renderTree = forall str. StringLike str => [Tag str] -> str
renderTags forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall str. [TagTree str] -> [Tag str]
flattenTree
renderTreeOptions :: StringLike str => RenderOptions str -> [TagTree str] -> str
renderTreeOptions :: forall str.
StringLike str =>
RenderOptions str -> [TagTree str] -> str
renderTreeOptions RenderOptions str
opts [TagTree str]
trees = forall str. StringLike str => RenderOptions str -> [Tag str] -> str
renderTagsOptions RenderOptions str
opts forall a b. (a -> b) -> a -> b
$ forall str. [TagTree str] -> [Tag str]
flattenTree [TagTree str]
trees
universeTree :: [TagTree str] -> [TagTree str]
universeTree :: forall str. [TagTree str] -> [TagTree str]
universeTree = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {str}. TagTree str -> [TagTree str]
f
where
f :: TagTree str -> [TagTree str]
f t :: TagTree str
t@(TagBranch str
_ [Attribute str]
_ [TagTree str]
inner) = TagTree str
t forall a. a -> [a] -> [a]
: forall str. [TagTree str] -> [TagTree str]
universeTree [TagTree str]
inner
f TagTree str
x = [TagTree str
x]
transformTree :: (TagTree str -> [TagTree str]) -> [TagTree str] -> [TagTree str]
transformTree :: forall str.
(TagTree str -> [TagTree str]) -> [TagTree str] -> [TagTree str]
transformTree TagTree str -> [TagTree str]
act = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TagTree str -> [TagTree str]
f
where
f :: TagTree str -> [TagTree str]
f (TagBranch str
a [Attribute str]
b [TagTree str]
inner) = TagTree str -> [TagTree str]
act forall a b. (a -> b) -> a -> b
$ forall str. str -> [Attribute str] -> [TagTree str] -> TagTree str
TagBranch str
a [Attribute str]
b (forall str.
(TagTree str -> [TagTree str]) -> [TagTree str] -> [TagTree str]
transformTree TagTree str -> [TagTree str]
act [TagTree str]
inner)
f TagTree str
x = TagTree str -> [TagTree str]
act TagTree str
x