Improve item location code, including some error detection

src/Dodge/DoubleTree.hs

@@ -47,12 +47,38 @@ dtToLRAdj f (DT x l r) = IM.insert i (Nothing,map g l , map g r)
     i = f x
     g = f . _dtValue
 
+-- returns an adjacency map with oldest ancestor and direct parent if they exist
+-- and any left and right children
+-- allows to propogate failure in the index discovery
+dtToLRAdjEither :: (a -> Either String Int) -> DoubleTree a 
+    -> Either String (IM.IntMap (Maybe (Int,Int),[Int],[Int]))
+dtToLRAdjEither f (DT x l r) = do
+    i <- f x
+    l' <- mapM g l
+    r' <- mapM g r
+    childrenasnodes <- mapM (dtToAdjRootParentEither i i f) $ l <> r
+    return $ IM.insert i (Nothing,l' , r') 
+        $ IM.unions childrenasnodes 
+  where 
+    g = f . _dtValue
+
 dtToAdjRootParent :: Int -> Int -> (a -> Int) -> DoubleTree a -> IM.IntMap (Maybe (Int,Int),[Int],[Int])
 dtToAdjRootParent root par f (DT x l r) = IM.insert (f x) (Just (root,par),map g l , map g r) 
     . IM.unions $ map (dtToAdjRootParent root (f x) f) $ l <> r
   where 
     g = f . _dtValue
 
+dtToAdjRootParentEither :: Int -> Int 
+    -> (a -> Either String Int) -> DoubleTree a -> Either String (IM.IntMap (Maybe (Int,Int),[Int],[Int]))
+dtToAdjRootParentEither root par f (DT x l r) = do
+    i <- f x
+    l' <- mapM g l
+    r' <- mapM g r
+    childrenasnodes <- mapM (dtToAdjRootParentEither root i f) $ l <> r
+    return $ IM.insert i (Just (root,par),l' , r') $ IM.unions childrenasnodes
+  where 
+    g = f . _dtValue
+
 ldtToIM :: (a -> Int) -> LabelDoubleTree b a -> IM.IntMap (LabelDoubleTree b a)
 ldtToIM f t@(LDT x l r) = IM.insert (f x) t $ IM.unions $ map (ldtToIM f . snd) $  l <> r