Work on orienting positions for attachment items

src/Dodge/DoubleTree.hs

@@ -2,6 +2,9 @@ module Dodge.DoubleTree where
 
 import Dodge.Data.DoubleTree
 import qualified Data.IntMap.Strict as IM
+import Control.Lens
+import Data.Bifunctor
+import Data.Monoid
 
 singleDT :: a -> DoubleTree a
 singleDT x = DT x [] []
@@ -9,10 +12,44 @@ singleDT x = DT x [] []
 singleLDT :: a -> LabelDoubleTree b a
 singleLDT x = LDT x [] []
 
-
 ldtToDT :: LabelDoubleTree b a -> DoubleTree a
 ldtToDT (LDT x l r) = DT x (map (ldtToDT . snd) l) (map (ldtToDT . snd) r)
 
+-- propogate two functions down the links of an LDT tree
+-- which function is chosen depends on whether it is a left or right branch
+ldtPropagate :: (c -> b -> c) -> (c -> b -> c) 
+    -> c 
+    -> LabelDoubleTree b a -> LabelDoubleTree c a
+ldtPropagate lf rf = ildtPropagate (const lf) (const rf)
+
+-- Propgates a value (of type c) down the branches of the LDT.
+-- The value is updated according a "left" or "right" function (lf or rf),
+-- that acts on the parent value, the link, and the child value.
+-- For each node, the updated value is used to update a final value (of type d).
+ldtPropagateFold :: (c -> a -> b -> a -> c) 
+    -> (c -> a -> b -> a -> c) 
+    -> (c -> a -> d -> d)
+    -> c 
+    -> LabelDoubleTree b a 
+    -> d 
+    -> d
+ldtPropagateFold lf rf up x (LDT v l r) = 
+    alaf Endo foldMap (\(s,y) -> ldtPropagateFold lf rf up (rf x v s (_ldtValue y)) y) r 
+    . alaf Endo foldMap (\(s,y) -> ldtPropagateFold lf rf up (lf x v s (_ldtValue y)) y) l 
+    . up x v
+
+ildtPropagate :: (Int -> c -> b -> c) -> (Int -> c -> b -> c) 
+    -> c 
+    -> LabelDoubleTree b a -> LabelDoubleTree c a
+ildtPropagate lf rf x (LDT v l r) = LDT v (imap (go lf x) l) (imap (go rf x) r)
+  where
+    go f y i (z,t) = (f i y z, ildtPropagate lf rf (f i y z) t)
+
+ldtPropagateIndices :: LabelDoubleTree b a -> LabelDoubleTree b (a, [Either Int Int])
+ldtPropagateIndices (LDT x l r) = LDT (x,[]) (imap (f Left) l) (imap (f Right) r)
+  where
+    f e i (y,t) = (y, fmap (second (e i:)) $ ldtPropagateIndices t)
+
 -- conceptually, in a tree growing from left to right, 
 -- bottom -> top is equated with left -> right.
 -- this does not match with thinking of a list as top -> bottom, so take care