Redo tree composition

src/Dodge/Tree/Compose.hs

@@ -4,18 +4,20 @@ module Dodge.Tree.Compose
     ( --expandTree
     --, pure
     --, pure
-    --, passUntiluseAll
     --, chainUses
     --, useAllAtEnd
     --, changeTo
-    --, overwriteLabel
     --, applyToCompRoot
-     composeTree
+    passUntiluseAll  -- this should be moved, and the dependency on Dodge.Data removed
+    , overwriteLabel
+    , composeTree
     , composeTree'
     , composeTreeRand
 --    , compTree
     ) where
+import Dodge.Data
 import Dodge.Tree.Compose.Data
+import Dodge.RoomCluster.Data
 import TreeHelp
 import Dodge.Base
 import LensHelp
@@ -39,6 +41,12 @@ import Data.Maybe
 --applyToCompRoot :: (a -> a) -> Tree a -> Tree a
 --applyToCompRoot f = over root (unCompose %~ f)
 
+overwriteLabel :: Int -> Tree Room -> [Tree Room] -> Tree Room
+overwriteLabel i t ts = safeUpdateSingleNode 
+    (\rm -> LabelCluster 0 `elem` (rm ^?! rmClusterStatus . csLinks))
+    ((branches .~ ts) . (root . rmClusterStatus . csLinks . at (LabelCluster 0) .~ Nothing))
+    t
+
 --overwriteLabel :: Int -> (a -> ComposingNode a) -> Tree a -> [Tree a] -> Tree a
 --overwriteLabel i f t ts = errorHead ("tried to overwriteLabel " ++ show i)
 --    $ updateSingleNodes islabel update t
@@ -47,7 +55,12 @@ import Data.Maybe
 --    islabel _ = False
 --    update (Node x _) = Node (f $ _unCompose x) ts
 
---passUntiluseAll :: Tree a -> [Tree a] -> Tree a
+passUntiluseAll :: Tree Room -> [Tree Room] -> Tree Room
+passUntiluseAll t ts = updateAllNodes 
+    ((OnwardCluster `elem`) . (^?! rmClusterStatus . csLinks))
+    ((branches .~ ts) . (root . rmClusterStatus . csLinks . at OnwardCluster .~ Nothing))
+    t
+    
 --passUntiluseAll (Node (useAll x) _) ts' = Node ( x) ts'
 --passUntiluseAll (Node cn ts) ts' = Node ( (_unCompose cn)) $ map (`passUntiluseAll` ts') ts