From 5f40f7e802df93954f96243f565db5724df4d3ac Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Sun, 19 Apr 2020 19:26:44 +1200
Subject: [PATCH] Abstract Tree traversal (commited out-of-order).

---
 src/Data/CSS/StyleTree.hs | 28 ++++++++++++++++++++++++++++
 1 file changed, 28 insertions(+)
 create mode 100644 src/Data/CSS/StyleTree.hs

diff --git a/src/Data/CSS/StyleTree.hs b/src/Data/CSS/StyleTree.hs
new file mode 100644
index 0000000..97e191a
--- /dev/null
+++ b/src/Data/CSS/StyleTree.hs
@@ -0,0 +1,28 @@
+-- | 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) 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)) ()
-- 
2.30.2