{-|
Combining and composing trees with 'Either' nodes.
-}
module Dodge.Layout.Tree.Either
    ( expandTreeBy
    , appendEitherTree
    , connectRoom
    , connectTrunk
    , deadRoom
    ) where
import Data.Tree

-- | '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'

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) [] 

{-  |
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) []

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