-- | Abstracts away tree traversals.
-- Mostly used by callers including (soon) XML Conduit Stylist,
-- but also used internally for generating counter text.
module Data.CSS.StyleTree(StyleTree(..), treeOrder, treeOrder', Path, treeMap, treeFlatten) where
data StyleTree p = StyleTree {
style :: p,
children :: [StyleTree p]
}
type Path = [Integer]
treeOrder :: (c -> c -> Path -> p -> (c, p')) ->
c -> StyleTree p -> StyleTree p'
treeOrder cb ctxt tree = StyleTree
(snd $ cb ctxt ctxt [] $ style tree)
(snd $ treeOrder' cb ctxt ctxt [0] $ children tree)
treeOrder' :: (c -> c -> Path -> p -> (c, p')) ->
c -> c -> Path -> [StyleTree p] -> (c, [StyleTree p'])
treeOrder' cb prevContext context (num:path) (node:nodes) = (tailContext, StyleTree node' children' : nodes')
where
(selfContext, node') = cb prevContext context (num:path) $ style node
(childContext, children') = treeOrder' cb selfContext selfContext (0:num:path) $ children node
(tailContext, nodes') = treeOrder' cb selfContext childContext (num + 1:path) nodes
treeOrder' _ _ context _ [] = (context, [])
treeOrder' _ _ _ [] _ = error "Invalid path during tree traversal!"
treeMap :: (p -> p') -> StyleTree p -> StyleTree p'
treeMap cb = treeOrder (\_ _ _ p -> ((), cb p)) ()
treeFlatten :: StyleTree p -> [p]
treeFlatten = treeFlatten' . children
treeFlatten' :: [StyleTree p] -> [p]
treeFlatten' (StyleTree p []:ps) = p : treeFlatten' ps
treeFlatten' (StyleTree _ childs:sibs) = treeFlatten' childs ++ treeFlatten' sibs
treeFlatten' [] = []