Commit mid big tree composing change
This commit is contained in:
+25
-25
@@ -2,12 +2,12 @@
|
||||
{-| Combining and composing trees of trees. -}
|
||||
module Dodge.Tree.Compose
|
||||
( --expandTree
|
||||
--, singleUseAll
|
||||
--, singleUseNone
|
||||
--, passUntilUseAll
|
||||
--, pure
|
||||
--, pure
|
||||
--, passUntiluseAll
|
||||
--, chainUses
|
||||
--, useAllAtEnd
|
||||
--, changeToPassDown
|
||||
--, changeTo
|
||||
--, overwriteLabel
|
||||
--, applyToCompRoot
|
||||
composeTree
|
||||
@@ -28,47 +28,47 @@ import Data.Maybe
|
||||
|
||||
--expandTree :: CompTree a -> Tree a
|
||||
--expandTree (Node rt extChildren) = case rt of
|
||||
-- Node (UseAll x) _ -> Node x (map expandTree extChildren)
|
||||
-- Node (useAll x) _ -> Node x (map expandTree extChildren)
|
||||
-- Node (UseSome is x) _ -> Node x (map (expandTree . \i -> extChildren !! i) is)
|
||||
-- Node (UseNone _) _ -> fmap _unCompose rt
|
||||
-- Node (UseLabel _ _) _ -> fmap _unCompose rt
|
||||
-- Node (PassDown x) xs -> Node x $ map (expandTree . (`Node` extChildren)) xs
|
||||
-- Node (useLabel _ _) _ -> fmap _unCompose rt
|
||||
-- Node ( x) xs -> Node x $ map (expandTree . (`Node` extChildren)) xs
|
||||
-- Node (SplitDown x) xs -> Node x $ map expandTree $ zipWith Node xs
|
||||
-- $ map (:[]) extChildren ++ repeat []
|
||||
|
||||
--applyToCompRoot :: (a -> a) -> SubCompTree a -> SubCompTree a
|
||||
--applyToCompRoot :: (a -> a) -> Tree a -> Tree a
|
||||
--applyToCompRoot f = over root (unCompose %~ f)
|
||||
|
||||
--overwriteLabel :: Int -> (a -> ComposingNode a) -> SubCompTree a -> [SubCompTree a] -> SubCompTree a
|
||||
--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
|
||||
-- where
|
||||
-- islabel (UseLabel j _) | i == j = True
|
||||
-- islabel (useLabel j _) | i == j = True
|
||||
-- islabel _ = False
|
||||
-- update (Node x _) = Node (f $ _unCompose x) ts
|
||||
|
||||
--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
|
||||
--passUntiluseAll :: Tree a -> [Tree a] -> Tree a
|
||||
--passUntiluseAll (Node (useAll x) _) ts' = Node ( x) ts'
|
||||
--passUntiluseAll (Node cn ts) ts' = Node ( (_unCompose cn)) $ map (`passUntiluseAll` ts') ts
|
||||
|
||||
--chainUses :: [SubCompTree a] -> SubCompTree a
|
||||
--chainUses (t:s:ts) = chainUses (passUntilUseAll t [s]:ts)
|
||||
--chainUses :: [Tree a] -> Tree a
|
||||
--chainUses (t:s:ts) = chainUses (passUntiluseAll t [s]:ts)
|
||||
--chainUses [t] = t
|
||||
--chainUses [] = error "tried to concatenate an empty list of SubCompTrees"
|
||||
--chainUses [] = error "tried to concatenate an empty list of Trees"
|
||||
|
||||
--singleUseAll :: a -> Tree (ComposingNode a)
|
||||
--singleUseAll x = Node (UseAll x) []
|
||||
--pure :: a -> Tree (ComposingNode a)
|
||||
--pure x = Node (useAll x) []
|
||||
|
||||
--useAllAtEnd :: Tree a -> SubCompTree a
|
||||
--useAllAtEnd :: Tree a -> Tree a
|
||||
--useAllAtEnd tree = case tree of
|
||||
-- Node x (t:ts) -> Node (PassDown x) (useAllAtEnd t : map (fmap UseNone) ts)
|
||||
-- Node x [] -> Node (UseAll x) []
|
||||
-- Node x (t:ts) -> Node ( x) (useAllAtEnd t : map (fmap UseNone) ts)
|
||||
-- Node x [] -> Node (useAll x) []
|
||||
|
||||
--singleUseNone :: a -> SubCompTree a
|
||||
--singleUseNone x = Node (UseNone x) []
|
||||
--pure :: a -> Tree a
|
||||
--pure x = Node (UseNone x) []
|
||||
|
||||
--changeToPassDown :: ComposingNode a -> ComposingNode a
|
||||
--changeToPassDown x = PassDown (_unCompose x)
|
||||
--changeTo :: ComposingNode a -> ComposingNode a
|
||||
--changeTo x = (_unCompose x)
|
||||
|
||||
composeTreeRand :: RandomGen g => Tree (a -> Maybe a, Tree a) -> State g (Tree a)
|
||||
composeTreeRand (Node (_,t) ts) = attachListR t ts
|
||||
|
||||
Reference in New Issue
Block a user