From e3beef67bcef116271da14637b376e084fe02bfc Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Fri, 8 May 2020 21:01:14 +1200
Subject: [PATCH] Add new style tree traversals.

---
 src/Data/CSS/StyleTree.hs | 17 ++++++++++++++++-
 1 file changed, 16 insertions(+), 1 deletion(-)

diff --git a/src/Data/CSS/StyleTree.hs b/src/Data/CSS/StyleTree.hs
index 6b7a6fa..9e1d90b 100644
--- a/src/Data/CSS/StyleTree.hs
+++ b/src/Data/CSS/StyleTree.hs
@@ -1,7 +1,8 @@
 -- | 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
+module Data.CSS.StyleTree(StyleTree(..), treeOrder, treeOrder',
+    Path, treeMap, treeFlatten, preorder, preorder', postorder) where
 
 data StyleTree p = StyleTree {
     style :: p,
@@ -33,3 +34,17 @@ treeFlatten' :: [StyleTree p] -> [p]
 treeFlatten' (StyleTree p []:ps) = p : treeFlatten' ps
 treeFlatten' (StyleTree _ childs:sibs) = treeFlatten' childs ++ treeFlatten' sibs
 treeFlatten' [] = []
+
+preorder :: (Maybe b -> Maybe b -> a -> b) -> StyleTree a -> StyleTree b
+preorder cb self = head $ preorder' cb Nothing Nothing [self]
+preorder' :: (Maybe b -> Maybe b -> a -> b) ->
+        Maybe b -> Maybe b -> [StyleTree a] -> [StyleTree b]
+preorder' cb parent previous (self:sibs) = let self' = cb parent previous $ style self
+        in StyleTree self' (preorder' cb (Just self') Nothing $ children self) :
+            preorder' cb parent (Just self') sibs
+preorder' _ _ _ [] = []
+
+postorder :: (a -> [b] -> [b]) -> StyleTree a -> [StyleTree b]
+postorder cb (StyleTree self childs) =
+    [StyleTree self' children' | self' <- cb self $ Prelude.map style children']
+  where children' = concat $ Prelude.map (postorder cb) childs
-- 
2.30.2