module Text.HTML.TagSoup.Tree
(
TagTree(..), tagTree,
flattenTree, transformTree, universeTree
) where
import Text.HTML.TagSoup.Type
data TagTree = TagBranch String [Attribute] [TagTree]
| TagLeaf Tag
deriving Show
tagTree :: [Tag] -> [TagTree]
tagTree = g
where
g :: [Tag] -> [TagTree]
g [] = []
g xs = a ++ map TagLeaf (take 1 b) ++ g (drop 1 b)
where (a,b) = f xs
f :: [Tag] -> ([TagTree],[Tag])
f (TagOpen name atts:rest) =
case f rest of
(inner,[]) -> (TagLeaf (TagOpen name atts):inner, [])
(inner,TagClose x:xs)
| x == name -> let (a,b) = f xs in (TagBranch name atts inner:a, b)
| otherwise -> (TagLeaf (TagOpen name atts):inner, TagClose x:xs)
_ -> error "TagSoup.Tree.tagTree: safe as - forall x . isTagClose (snd (f x))"
f (TagClose x:xs) = ([], TagClose x:xs)
f (x:xs) = (TagLeaf x:a,b)
where (a,b) = f xs
f [] = ([], [])
flattenTree :: [TagTree] -> [Tag]
flattenTree xs = concatMap f xs
where
f (TagBranch name atts inner) =
TagOpen name atts : flattenTree inner ++ [TagClose name]
f (TagLeaf x) = [x]
universeTree :: [TagTree] -> [TagTree]
universeTree = concatMap f
where
f t@(TagBranch _ _ inner) = t : universeTree inner
f x = [x]
transformTree :: (TagTree -> [TagTree]) -> [TagTree] -> [TagTree]
transformTree act = concatMap f
where
f (TagBranch a b inner) = act $ TagBranch a b (transformTree act inner)
f x = act x