Continue removing LDTs

src/Dodge/DoubleTree.hs

@@ -309,6 +309,12 @@ locLeftmost loc = maybe loc locLeftmost $ alaf First foldMap Just $ locGoLeft lo
 locRightmost :: LocationLDT b a -> LocationLDT b a
 locRightmost loc = maybe loc locRightmost $ alaf Last foldMap Just $ locGoRight loc
 
+locDTLeftmost :: LocationDT a -> LocationDT a
+locDTLeftmost loc = maybe loc locDTLeftmost $ alaf First foldMap Just $ locDTGoLeft loc
+
+locDTRightmost :: LocationDT a -> LocationDT a
+locDTRightmost loc = maybe loc locDTRightmost $ alaf Last foldMap Just $ locDTGoRight loc
+
 -- should probably do tests for these
 locGoLeft :: LocationLDT b a -> [LocationLDT b a]
 locGoLeft (LocLDT c (LDT v l r)) =
@@ -319,6 +325,16 @@ locGoRight :: LocationLDT b a -> [LocationLDT b a]
 locGoRight (LocLDT c (LDT v l r)) =
     [LocLDT (RightwardLDT c l closel v link closer) t | (closel, (link, t), closer) <- locGoHelp id r]
 
+-- should probably do tests for these
+locDTGoLeft :: LocationDT a -> [LocationDT a]
+locDTGoLeft (LocDT c (DT v l r)) =
+    [LocDT (LeftwardDT c closel v closer r) t | (closel,  t, closer) <- locDTGoHelp id l]
+
+-- should probably do tests for these
+locDTGoRight :: LocationDT a -> [LocationDT a]
+locDTGoRight (LocDT c (DT v l r)) =
+    [LocDT (RightwardDT c l closel v closer) t | (closel, ( t), closer) <- locDTGoHelp id r]
+
 -- this seems like it might be very inefficient for large lists
 -- difference lists?
 locGoHelp :: (a -> b) -> [a] -> [([a], b, [a])]
@@ -327,6 +343,14 @@ locGoHelp f = go []
     go cleft (y : ys) = (cleft, f y, ys) : go (cleft <> [y]) ys
     go _ [] = []
 
+-- this seems like it might be very inefficient for large lists
+-- difference lists?
+locDTGoHelp :: (a -> b) -> [a] -> [([a], b, [a])]
+locDTGoHelp f = go []
+  where
+    go cleft (y : ys) = (cleft, f y, ys) : go (cleft <> [y]) ys
+    go _ [] = []
+
 -- Propgates a value (of type c) down the branches of the ContextLDT.
 -- 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.
@@ -370,3 +394,47 @@ reduceLocLDT :: Monoid m => (LocationLDT b a -> m) -> LocationLDT b a -> m
 reduceLocLDT f x =
     foldMap (reduceLocLDT f) (locGoLeft x) <> f x
         <> foldMap (reduceLocLDT f) (locGoRight x)
+
+reduceLocDT :: Monoid m => (LocationDT a -> m) -> LocationDT a -> m
+reduceLocDT f x =
+    foldMap (reduceLocDT f) (locDTGoLeft x) <> f x
+        <> foldMap (reduceLocDT f) (locDTGoRight x)
+
+-- Propgates a value (of type c) down the branches of the ContextLDT.
+-- The value is updated according a "left" or "right" function (lf or rf),
+-- that acts on the parent value and the child value.
+-- For each context node, the updated value is used to update a final value (of type d).
+cdtPropagateFold ::
+    (c -> a -> a -> c) ->
+    (c -> a -> a -> c) ->
+    (c -> LocationDT a -> d -> d) ->
+    c ->
+    LocationDT a ->
+    d ->
+    d
+cdtPropagateFold lf rf up x loc =
+    alaf
+        Endo
+        foldMap
+        ( \(LocDT con' t') ->
+            cdtPropagateFold
+                lf
+                rf
+                up
+                (lf x (_cdtParent con') (_dtValue t'))
+                (LocDT con' t')
+        )
+        (locDTGoLeft loc)
+        . alaf
+            Endo
+            foldMap
+            ( \(LocDT con' t') ->
+                cdtPropagateFold
+                    lf
+                    rf
+                    up
+                    (rf x (_cdtParent con') (_dtValue t'))
+                    (LocDT con' t')
+            )
+            (locDTGoRight loc)
+        . up x loc