~alcinnz/haskell-stylist

ref: 5e3bd086b6d7adbbbcb6b401b5cb3f92017d0aaf haskell-stylist/src/Data/CSS/StyleTree.hs -rw-r--r-- 1.5 KiB
5e3bd086 — Adrian Cochrane ISSUES: Text properties *mostly* implemented, upstreamed from Rhapsode core. 4 years ago 
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
-- | 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' [] = []