Fold in new composing room datatype

src/Dodge/Tree/Compose.hs

@@ -6,7 +6,6 @@ module Dodge.Tree.Compose
     , connectTrunk
     , deadRoom
     , linkEitherTrees
-
     , expandTree
     , singleUseAll
     , singleUseNone
@@ -26,51 +25,71 @@ expandTree (Node root extChildren) = case root of
     Node (SplitDown x)  xs  -> Node x $ map expandTree $ zipWith Node xs 
             $ map (:[]) extChildren ++ repeat []
 
--- | 'Left' elements get new children as given by the node function, 
--- 'Right' elements inherit the children from the base tree
-expandTreeBy 
-    :: (a -> Tree (Either b b)) -- ^ Node function
+expandTreeBy
+    :: (a -> SubCompTree b) -- ^ Node function
     -> Tree a                   -- ^ Base tree
     -> Tree b
-expandTreeBy f (Node x []) = fmap removeEither (f x)
+expandTreeBy f (Node x []) = fmap _unCompose (f x)
 expandTreeBy f (Node x xs) = appendAndRemove $ f x
   where
-    appendAndRemove (Node (Left y)  ys) = Node y (map appendAndRemove ys)
-    appendAndRemove (Node (Right y) _ ) = Node y (map (expandTreeBy f) xs)
+    appendAndRemove (Node (PassDown y) ys) = Node y (map appendAndRemove ys)
+    appendAndRemove (Node (UseAll y)   _ ) = Node y (map (expandTreeBy f) xs)
+    
+
+---- | 'Left' elements get new children as given by the node function, 
+---- 'Right' elements inherit the children from the base tree
+--expandTreeBy 
+--    :: (a -> Tree (Either b b)) -- ^ Node function
+--    -> Tree a                   -- ^ Base tree
+--    -> Tree b
+--expandTreeBy f (Node x []) = fmap removeEither (f x)
+--expandTreeBy f (Node x xs) = appendAndRemove $ f x
+--  where
+--    appendAndRemove (Node (Left y)  ys) = Node y (map appendAndRemove ys)
+--    appendAndRemove (Node (Right y) _ ) = Node y (map (expandTreeBy f) xs)
 
 -- | Appends a second either forest at the 'Right' elements of a first either
 -- tree.
 -- Makes such 'Right' elements into 'Left's.
-appendEitherTree 
-    :: Tree (Either a a)    -- ^ The first tree
-    -> [Tree (Either a a)]    -- ^ The forest to append
-    -> Tree (Either a a)
-appendEitherTree (Node (Left x) ts) ts'  = Node (Left x) $ map (`appendEitherTree` ts') ts
-appendEitherTree (Node (Right x) _) ts' = Node (Left x) ts'
+--appendEitherTree 
+--    :: Tree (Either a a)    -- ^ The first tree
+--    -> [Tree (Either a a)]    -- ^ The forest to append
+--    -> Tree (Either a a)
+--appendEitherTree (Node (Left x) ts) ts'  = Node (Left x) $ map (`appendEitherTree` ts') ts
+--appendEitherTree (Node (Right x) _) ts' = Node (Left x) ts'
+
+appendEitherTree = passUntilUseAll
+
 passUntilUseAll :: SubCompTree a -> [SubCompTree a] -> SubCompTree a
 passUntilUseAll (Node (UseAll x) _) ts' = Node (PassDown x) ts'
 passUntilUseAll (Node cn ts) ts' = Node (PassDown (_unCompose cn)) $ map (`passUntilUseAll` ts') ts
 
-linkEitherTrees :: [Tree (Either a a)] -> Tree (Either a a)
-linkEitherTrees (t:s:ts) = linkEitherTrees (appendEitherTree t [s]:ts)
-linkEitherTrees [t] = t
-linkEitherTrees [] = error "tried to concatenate an empty list of either trees"
+--linkEitherTrees :: [Tree (Either a a)] -> Tree (Either a a)
+--linkEitherTrees (t:s:ts) = linkEitherTrees (appendEitherTree t [s]:ts)
+--linkEitherTrees [t] = t
+--linkEitherTrees [] = error "tried to concatenate an empty list of either trees"
+
+linkEitherTrees = chainUses
 
 chainUses :: [SubCompTree a] -> SubCompTree a
 chainUses (t:s:ts) = chainUses (passUntilUseAll t [s]:ts)
 chainUses [t] = t
 chainUses []  = error "tried to concatenate an empty list of SubCompTrees"
 
+removeEither = _unCompose
+
 -- this is _unCompose
-removeEither :: Either p p -> p
-removeEither (Left y)  = y
-removeEither (Right y) = y
+--removeEither :: Either p p -> p
+--removeEither (Left y)  = y
+--removeEither (Right y) = y
 
 {-  |
 Make a singleton connection of an Either Tree.
 -}
-connectRoom :: a -> Tree (Either a a)
-connectRoom r = Node (Right r) [] 
+--connectRoom :: a -> Tree (Either a a)
+--connectRoom r = Node (Right r) [] 
+
+connectRoom = singleUseAll
 
 singleUseAll :: a -> Tree (ComposingNode a)
 singleUseAll x = Node (UseAll x) []
@@ -78,10 +97,11 @@ singleUseAll x = Node (UseAll x) []
 {-  |
 Make a single Either connection at the end of a tree.
 -}
-connectTrunk :: Tree a -> Tree (Either a a)
-connectTrunk (Node x (t:ts)) = Node (Left x) (connectTrunk t : map (fmap Left) ts)
-connectTrunk (Node x []) = Node (Right x) []
-
+--connectTrunk :: Tree a -> Tree (Either a a)
+--connectTrunk (Node x (t:ts)) = Node (Left x) (connectTrunk t : map (fmap Left) ts)
+--connectTrunk (Node x []) = Node (Right x) []
+--
+connectTrunk = useAllAtEnd
 useAllAtEnd :: Tree a -> SubCompTree a
 useAllAtEnd tree = case tree of
     Node x (t:ts)   -> Node (PassDown x) (useAllAtEnd t : map (fmap UseNone) ts)
@@ -90,8 +110,10 @@ useAllAtEnd tree = case tree of
 {- |
 Make a singleton dead end of an Either Tree.
 -}
-deadRoom :: a -> Tree (Either a a)
-deadRoom r = Node (Left r) []
+--deadRoom :: a -> Tree (Either a a)
+--deadRoom r = Node (Left r) []
+
+deadRoom = singleUseNone
 
 singleUseNone :: a -> SubCompTree a
 singleUseNone x = Node (UseNone x) []