{-# LANGUAGE ExistentialQuantification #-}
{-# OPTIONS -Wall #-}

{- | Functions to get the tree of wxHaskell widgets, from a 'GenWid'.
-}
module Graphics.UI.WxGeneric.GenericWidget.WidgetTree
    ( WidTree, WxWindow(..)
    , WidgetTree(..)
    -- * WidTree constructors
    , mkWidTree, singleChild, leafWidTree
    -- * Update/get ops
    , getChildren, updateChildren, getSubTrees, updateSubTrees
    -- * Traversal
    , depthFirstTraversal
    )
where

import Graphics.UI.WX

type Update a = a -> a
data WidTree = WidTree [WxWindow] [WidTree]
data WxWindow = forall w. WxWindow (Window w)

getChildren :: WidTree -> [WxWindow]
getChildren (WidTree x _) = x

updateChildren ::  Update [WxWindow] -> Update WidTree
updateChildren f (WidTree x y) = (WidTree (f x) y) 

getSubTrees :: WidTree -> [WidTree]
getSubTrees (WidTree _ x) = x

updateSubTrees :: Update [WidTree] -> Update WidTree
updateSubTrees f (WidTree x y) = WidTree x (f y)

-- | Construct 'WidTree'
mkWidTree :: [WxWindow] -> [WidTree] -> WidTree
mkWidTree = WidTree

-- |Construct 'WidTree' leaf node.
leafWidTree :: [WxWindow] -> IO WidTree
leafWidTree cs = return $ WidTree cs []

-- |Construct 'WidTree' from a single WxHaskell widget.
singleChild :: Window w -> IO WidTree
singleChild w = leafWidTree [WxWindow w]

-- |Depth first traversal of 'WidTree'
-- FIXME: Is not really, or atleast do not seem like a depth first traversal to the
-- the user of WxGeneric.
depthFirstTraversal :: WidTree -> [Window ()]
depthFirstTraversal (WidTree wids cs)
    = concatMap depthFirstTraversal cs ++ map toWindowOOClass wids

-- |Converts to 'Window ()' - that is high up in the wxWidgets OO (Object Oriented)
-- type hierarchy.
toWindowOOClass :: WxWindow -> Window ()
toWindowOOClass (WxWindow c) = objectCast c

class WidgetTree w where
    -- | Get all wxHaskell widgets (Window w) which are inputable.
    -- That is, we get widgets like text-entries and slides, but not widgets like labels.
    widgetTree :: ReadAttr w WidTree