-- | 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, preorder, preorder', postorder) where

data StyleTree p = StyleTree {
    StyleTree p -> p
style :: p,
    StyleTree p -> [StyleTree p]
children :: [StyleTree p]
}

type Path = [Integer]
treeOrder :: (c -> c -> Path -> p -> (c, p')) ->
    c -> StyleTree p -> StyleTree p'
treeOrder :: (c -> c -> Path -> p -> (c, p'))
-> c -> StyleTree p -> StyleTree p'
treeOrder c -> c -> Path -> p -> (c, p')
cb c
ctxt StyleTree p
tree = p' -> [StyleTree p'] -> StyleTree p'
forall p. p -> [StyleTree p] -> StyleTree p
StyleTree
    ((c, p') -> p'
forall a b. (a, b) -> b
snd ((c, p') -> p') -> (c, p') -> p'
forall a b. (a -> b) -> a -> b
$ c -> c -> Path -> p -> (c, p')
cb c
ctxt c
ctxt [] (p -> (c, p')) -> p -> (c, p')
forall a b. (a -> b) -> a -> b
$ StyleTree p -> p
forall p. StyleTree p -> p
style StyleTree p
tree)
    ((c, [StyleTree p']) -> [StyleTree p']
forall a b. (a, b) -> b
snd ((c, [StyleTree p']) -> [StyleTree p'])
-> (c, [StyleTree p']) -> [StyleTree p']
forall a b. (a -> b) -> a -> b
$ (c -> c -> Path -> p -> (c, p'))
-> c -> c -> Path -> [StyleTree p] -> (c, [StyleTree p'])
forall c p p'.
(c -> c -> Path -> p -> (c, p'))
-> c -> c -> Path -> [StyleTree p] -> (c, [StyleTree p'])
treeOrder' c -> c -> Path -> p -> (c, p')
cb c
ctxt c
ctxt [Integer
0] ([StyleTree p] -> (c, [StyleTree p']))
-> [StyleTree p] -> (c, [StyleTree p'])
forall a b. (a -> b) -> a -> b
$ StyleTree p -> [StyleTree p]
forall p. StyleTree p -> [StyleTree p]
children StyleTree p
tree)
treeOrder' :: (c -> c -> Path -> p -> (c, p')) ->
    c -> c -> Path -> [StyleTree p] -> (c, [StyleTree p'])
treeOrder' :: (c -> c -> Path -> p -> (c, p'))
-> c -> c -> Path -> [StyleTree p] -> (c, [StyleTree p'])
treeOrder' c -> c -> Path -> p -> (c, p')
cb c
prevContext c
context (Integer
num:Path
path) (StyleTree p
node:[StyleTree p]
nodes) = (c
tailContext, p' -> [StyleTree p'] -> StyleTree p'
forall p. p -> [StyleTree p] -> StyleTree p
StyleTree p'
node' [StyleTree p']
children' StyleTree p' -> [StyleTree p'] -> [StyleTree p']
forall a. a -> [a] -> [a]
: [StyleTree p']
nodes')
    where
        (c
selfContext, p'
node') = c -> c -> Path -> p -> (c, p')
cb c
prevContext c
context (Integer
numInteger -> Path -> Path
forall a. a -> [a] -> [a]
:Path
path) (p -> (c, p')) -> p -> (c, p')
forall a b. (a -> b) -> a -> b
$ StyleTree p -> p
forall p. StyleTree p -> p
style StyleTree p
node
        (c
childContext, [StyleTree p']
children') = (c -> c -> Path -> p -> (c, p'))
-> c -> c -> Path -> [StyleTree p] -> (c, [StyleTree p'])
forall c p p'.
(c -> c -> Path -> p -> (c, p'))
-> c -> c -> Path -> [StyleTree p] -> (c, [StyleTree p'])
treeOrder' c -> c -> Path -> p -> (c, p')
cb c
selfContext c
selfContext (Integer
0Integer -> Path -> Path
forall a. a -> [a] -> [a]
:Integer
numInteger -> Path -> Path
forall a. a -> [a] -> [a]
:Path
path) ([StyleTree p] -> (c, [StyleTree p']))
-> [StyleTree p] -> (c, [StyleTree p'])
forall a b. (a -> b) -> a -> b
$ StyleTree p -> [StyleTree p]
forall p. StyleTree p -> [StyleTree p]
children StyleTree p
node
        (c
tailContext, [StyleTree p']
nodes') = (c -> c -> Path -> p -> (c, p'))
-> c -> c -> Path -> [StyleTree p] -> (c, [StyleTree p'])
forall c p p'.
(c -> c -> Path -> p -> (c, p'))
-> c -> c -> Path -> [StyleTree p] -> (c, [StyleTree p'])
treeOrder' c -> c -> Path -> p -> (c, p')
cb c
selfContext c
childContext (Integer
num Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1Integer -> Path -> Path
forall a. a -> [a] -> [a]
:Path
path) [StyleTree p]
nodes
treeOrder' c -> c -> Path -> p -> (c, p')
_ c
_ c
context Path
_ [] = (c
context, [])
treeOrder' c -> c -> Path -> p -> (c, p')
_ c
_ c
_ [] [StyleTree p]
_ = [Char] -> (c, [StyleTree p'])
forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid path during tree traversal!"

treeMap :: (p -> p') -> StyleTree p -> StyleTree p'
treeMap :: (p -> p') -> StyleTree p -> StyleTree p'
treeMap p -> p'
cb = (() -> () -> Path -> p -> ((), p'))
-> () -> StyleTree p -> StyleTree p'
forall c p p'.
(c -> c -> Path -> p -> (c, p'))
-> c -> StyleTree p -> StyleTree p'
treeOrder (\()
_ ()
_ Path
_ p
p -> ((), p -> p'
cb p
p)) ()

treeFlatten :: StyleTree p -> [p]
treeFlatten :: StyleTree p -> [p]
treeFlatten = [StyleTree p] -> [p]
forall p. [StyleTree p] -> [p]
treeFlatten' ([StyleTree p] -> [p])
-> (StyleTree p -> [StyleTree p]) -> StyleTree p -> [p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleTree p -> [StyleTree p]
forall p. StyleTree p -> [StyleTree p]
children
treeFlatten' :: [StyleTree p] -> [p]
treeFlatten' :: [StyleTree p] -> [p]
treeFlatten' (StyleTree p
p []:[StyleTree p]
ps) = p
p p -> [p] -> [p]
forall a. a -> [a] -> [a]
: [StyleTree p] -> [p]
forall p. [StyleTree p] -> [p]
treeFlatten' [StyleTree p]
ps
treeFlatten' (StyleTree p
_ [StyleTree p]
childs:[StyleTree p]
sibs) = [StyleTree p] -> [p]
forall p. [StyleTree p] -> [p]
treeFlatten' [StyleTree p]
childs [p] -> [p] -> [p]
forall a. [a] -> [a] -> [a]
++ [StyleTree p] -> [p]
forall p. [StyleTree p] -> [p]
treeFlatten' [StyleTree p]
sibs
treeFlatten' [] = []

preorder :: (Maybe b -> Maybe b -> a -> b) -> StyleTree a -> StyleTree b
preorder :: (Maybe b -> Maybe b -> a -> b) -> StyleTree a -> StyleTree b
preorder Maybe b -> Maybe b -> a -> b
cb StyleTree a
self = [StyleTree b] -> StyleTree b
forall a. [a] -> a
head ([StyleTree b] -> StyleTree b) -> [StyleTree b] -> StyleTree b
forall a b. (a -> b) -> a -> b
$ (Maybe b -> Maybe b -> a -> b)
-> Maybe b -> Maybe b -> [StyleTree a] -> [StyleTree b]
forall b a.
(Maybe b -> Maybe b -> a -> b)
-> Maybe b -> Maybe b -> [StyleTree a] -> [StyleTree b]
preorder' Maybe b -> Maybe b -> a -> b
cb Maybe b
forall a. Maybe a
Nothing Maybe b
forall a. Maybe a
Nothing [StyleTree a
self]
preorder' :: (Maybe b -> Maybe b -> a -> b) ->
        Maybe b -> Maybe b -> [StyleTree a] -> [StyleTree b]
preorder' :: (Maybe b -> Maybe b -> a -> b)
-> Maybe b -> Maybe b -> [StyleTree a] -> [StyleTree b]
preorder' Maybe b -> Maybe b -> a -> b
cb Maybe b
parent Maybe b
previous (StyleTree a
self:[StyleTree a]
sibs) = let self' :: b
self' = Maybe b -> Maybe b -> a -> b
cb Maybe b
parent Maybe b
previous (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ StyleTree a -> a
forall p. StyleTree p -> p
style StyleTree a
self
        in b -> [StyleTree b] -> StyleTree b
forall p. p -> [StyleTree p] -> StyleTree p
StyleTree b
self' ((Maybe b -> Maybe b -> a -> b)
-> Maybe b -> Maybe b -> [StyleTree a] -> [StyleTree b]
forall b a.
(Maybe b -> Maybe b -> a -> b)
-> Maybe b -> Maybe b -> [StyleTree a] -> [StyleTree b]
preorder' Maybe b -> Maybe b -> a -> b
cb (b -> Maybe b
forall a. a -> Maybe a
Just b
self') Maybe b
forall a. Maybe a
Nothing ([StyleTree a] -> [StyleTree b]) -> [StyleTree a] -> [StyleTree b]
forall a b. (a -> b) -> a -> b
$ StyleTree a -> [StyleTree a]
forall p. StyleTree p -> [StyleTree p]
children StyleTree a
self) StyleTree b -> [StyleTree b] -> [StyleTree b]
forall a. a -> [a] -> [a]
:
            (Maybe b -> Maybe b -> a -> b)
-> Maybe b -> Maybe b -> [StyleTree a] -> [StyleTree b]
forall b a.
(Maybe b -> Maybe b -> a -> b)
-> Maybe b -> Maybe b -> [StyleTree a] -> [StyleTree b]
preorder' Maybe b -> Maybe b -> a -> b
cb Maybe b
parent (b -> Maybe b
forall a. a -> Maybe a
Just b
self') [StyleTree a]
sibs
preorder' Maybe b -> Maybe b -> a -> b
_ Maybe b
_ Maybe b
_ [] = []

postorder :: (a -> [b] -> [b]) -> StyleTree a -> [StyleTree b]
postorder :: (a -> [b] -> [b]) -> StyleTree a -> [StyleTree b]
postorder a -> [b] -> [b]
cb (StyleTree a
self [StyleTree a]
childs) =
    [b -> [StyleTree b] -> StyleTree b
forall p. p -> [StyleTree p] -> StyleTree p
StyleTree b
self' [StyleTree b]
children' | b
self' <- a -> [b] -> [b]
cb a
self ([b] -> [b]) -> [b] -> [b]
forall a b. (a -> b) -> a -> b
$ (StyleTree b -> b) -> [StyleTree b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map StyleTree b -> b
forall p. StyleTree p -> p
style [StyleTree b]
children']
  where children' :: [StyleTree b]
children' = [[StyleTree b]] -> [StyleTree b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[StyleTree b]] -> [StyleTree b])
-> [[StyleTree b]] -> [StyleTree b]
forall a b. (a -> b) -> a -> b
$ (StyleTree a -> [StyleTree b]) -> [StyleTree a] -> [[StyleTree b]]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map ((a -> [b] -> [b]) -> StyleTree a -> [StyleTree b]
forall a b. (a -> [b] -> [b]) -> StyleTree a -> [StyleTree b]
postorder a -> [b] -> [b]
cb) [StyleTree a]
childs