{-|
/NOTE/: This module is preliminary and may change at a future date.
This module is intended to help converting a list of tags into a
tree of tags.
-}moduleText.HTML.TagSoup.Tree(TagTree(..),tagTree,flattenTree,transformTree,universeTree)whereimportText.HTML.TagSoup.TypeimportControl.ArrowdataTagTreestr=TagBranchstr[Attributestr][TagTreestr]|TagLeaf(Tagstr)deriving(Eq,Ord,Show)instanceFunctorTagTreewherefmapf(TagBranchxyz)=TagBranch(fx)(map(f***f)y)(map(fmapf)z)fmapf(TagLeafx)=TagLeaf(fmapfx)-- | Convert a list of tags into a tree. This version is not lazy at-- all, that is saved for version 2.tagTree::Eqstr=>[Tagstr]->[TagTreestr]tagTree=gwhereg::Eqstr=>[Tagstr]->[TagTreestr]g[]=[]gxs=a++mapTagLeaf(take1b)++g(drop1b)where(a,b)=fxs-- the second tuple is either null or starts with a closef::Eqstr=>[Tagstr]->([TagTreestr],[Tagstr])f(TagOpennameatts:rest)=casefrestof(inner,[])->(TagLeaf(TagOpennameatts):inner,[])(inner,TagClosex:xs)|x==name->let(a,b)=fxsin(TagBranchnameattsinner:a,b)|otherwise->(TagLeaf(TagOpennameatts):inner,TagClosex:xs)_->error"TagSoup.Tree.tagTree: safe as - forall x . isTagClose (snd (f x))"f(TagClosex:xs)=([],TagClosex:xs)f(x:xs)=(TagLeafx:a,b)where(a,b)=fxsf[]=([],[])flattenTree::[TagTreestr]->[Tagstr]flattenTreexs=concatMapfxswheref(TagBranchnameattsinner)=TagOpennameatts:flattenTreeinner++[TagClosename]f(TagLeafx)=[x]-- | This operation is based on the Uniplate @universe@ function. Given a-- list of trees, it returns those trees, and all the children trees at-- any level. For example:---- > universeTree-- > [TagBranch "a" [("href","url")] [TagBranch "b" [] [TagLeaf (TagText "text")]]]-- > == [TagBranch "a" [("href","url")] [TagBranch "b" [] [TagLeaf (TagText "text")]]]-- > ,TagBranch "b" [] [TagLeaf (TagText "text")]]---- This operation is particularly useful for queries. To collect all @\"a\"@-- tags in a tree, simply do:---- > [x | x@(TagTree "a" _ _) <- universeTree tree]universeTree::[TagTreestr]->[TagTreestr]universeTree=concatMapfwhereft@(TagBranch__inner)=t:universeTreeinnerfx=[x]-- | This operation is based on the Uniplate @transform@ function. Given a-- list of trees, it applies the function to every tree in a bottom-up-- manner. This operation is useful for manipulating a tree - for example-- to make all tag names upper case:---- > upperCase = transformTree f-- > where f (TagBranch name atts inner) = [TagBranch (map toUpper name) atts inner]-- > f x = xtransformTree::(TagTreestr->[TagTreestr])->[TagTreestr]->[TagTreestr]transformTreeact=concatMapfwheref(TagBranchabinner)=act$TagBranchab(transformTreeactinner)fx=actx