{-| Combining and composing trees of trees.  -}
module Dodge.Tree.Compose
    ( expandTreeBy
    , appendEitherTree
    , connectRoom
    , connectTrunk
    , deadRoom
    , linkEitherTrees
    , expandTree
    , singleUseAll
    , singleUseNone
    , passUntilUseAll
    , chainUses
    , useAllAtEnd
    ) where
import Dodge.Tree.Compose.Data
import Data.Tree

expandTree :: CompTree a -> Tree a
expandTree (Node root extChildren) = case root of
    Node (UseAll x)     _   -> Node x (map expandTree extChildren)
    Node (UseSome is x) _   -> Node x (map expandTree $ map (\i -> extChildren !! i) is)
    Node (UseNone _)    _   -> fmap _unCompose root
    Node (PassDown x)   xs  -> Node x $ map (expandTree . (\ct -> Node ct extChildren)) xs
    Node (SplitDown x)  xs  -> Node x $ map expandTree $ zipWith Node xs 
            $ map (:[]) extChildren ++ repeat []

expandTreeBy
    :: (a -> SubCompTree b) -- ^ Node function
    -> Tree a                   -- ^ Base tree
    -> Tree b
expandTreeBy f (Node x []) = fmap _unCompose (f x)
expandTreeBy f (Node x xs) = appendAndRemove $ f x
  where
    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 = 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 = 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

{-  |
Make a singleton connection of an Either Tree.
-}
--connectRoom :: a -> Tree (Either a a)
--connectRoom r = Node (Right r) [] 

connectRoom = singleUseAll

singleUseAll :: a -> Tree (ComposingNode a)
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 = useAllAtEnd
useAllAtEnd :: Tree a -> SubCompTree a
useAllAtEnd tree = case tree of
    Node x (t:ts)   -> Node (PassDown x) (useAllAtEnd t : map (fmap UseNone) ts)
    Node x []       -> Node (UseAll x) []

{- |
Make a singleton dead end of an Either Tree.
-}
--deadRoom :: a -> Tree (Either a a)
--deadRoom r = Node (Left r) []

deadRoom = singleUseNone

singleUseNone :: a -> SubCompTree a
singleUseNone x = Node (UseNone x) []