{-# LANGUAGE DataKinds      #-}
{-# LANGUAGE GADTs          #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes     #-}
-- | The 'StateTree' and 'SomeState' form a "shadow state"
-- representation, used in patching. Declarative widgets can return,
-- and later on reuse, its underlying GTK+ widget, collected
-- properties and classes, style context, custom internal state, and
-- child states. This reduces the need for querying GTK+ widgets
-- excessively, and recalculating/resetting, greatly improving the
-- performance of patching.
module GI.Gtk.Declarative.State where

import           Data.Typeable

import           Data.Vector                             (Vector)
import qualified GI.Gtk                                  as Gtk

import           GI.Gtk.Declarative.Attributes.Collected
import           GI.Gtk.Declarative.Container.Class

-- | A 'Data.Dynamic.Dynamic'-like container of a 'StateTree' value.
data SomeState where
  SomeState
    :: ( Gtk.IsWidget widget
      , Typeable widget
      , Typeable customState
      )
    => StateTree stateType widget child event customState
    -> SomeState

-- | The types of state trees that are available, matching the types
-- of GTK+ widgets (single widget, bin, and container.)
data StateType = WidgetState | BinState | ContainerState

-- | A state tree for a specific 'widget'. This is built up recursively
-- to contain child state trees, for bin and container child widgets.
data StateTree (stateType :: StateType) widget child event customState where
  StateTreeWidget
    :: !(StateTreeNode widget event customState)
    -> StateTree 'WidgetState widget child event customState
  StateTreeBin
    :: !(StateTreeNode widget event customState)
    -> SomeState
    -> StateTree 'BinState widget child event customState
  StateTreeContainer
    :: ( Gtk.IsContainer widget
       , IsContainer widget child
       )
    => !(StateTreeNode widget event customState)
    -> Vector SomeState
    -> StateTree 'ContainerState widget child event customState

-- | The common structure for all state tree nodes.
data StateTreeNode widget event customState = StateTreeNode
  { StateTreeNode widget event customState -> widget
stateTreeWidget              :: !widget
  , StateTreeNode widget event customState -> StyleContext
stateTreeStyleContext        :: !Gtk.StyleContext
  , StateTreeNode widget event customState -> Collected widget event
stateTreeCollectedAttributes :: !(Collected widget event)
  , StateTreeNode widget event customState -> customState
stateTreeCustomState         :: customState
  }

-- * Convenience accessor functions

-- | Get the common state tree node information.
stateTreeNode
  :: StateTree stateType widget child event customState
  -> StateTreeNode widget event customState
stateTreeNode :: StateTree stateType widget child event customState
-> StateTreeNode widget event customState
stateTreeNode (StateTreeWidget s :: StateTreeNode widget event customState
s     ) = StateTreeNode widget event customState
s
stateTreeNode (StateTreeBin       s :: StateTreeNode widget event customState
s _) = StateTreeNode widget event customState
s
stateTreeNode (StateTreeContainer s :: StateTreeNode widget event customState
s _) = StateTreeNode widget event customState
s

-- | Get the specific type of GTK+ widget of a state tree.
stateTreeNodeWidget :: StateTree stateType widget child event customState -> widget
stateTreeNodeWidget :: StateTree stateType widget child event customState -> widget
stateTreeNodeWidget = StateTreeNode widget event customState -> widget
forall widget event customState.
StateTreeNode widget event customState -> widget
stateTreeWidget (StateTreeNode widget event customState -> widget)
-> (StateTree stateType widget child event customState
    -> StateTreeNode widget event customState)
-> StateTree stateType widget child event customState
-> widget
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateTree stateType widget child event customState
-> StateTreeNode widget event customState
forall (stateType :: StateType) widget (child :: * -> *) event
       customState.
StateTree stateType widget child event customState
-> StateTreeNode widget event customState
stateTreeNode

-- | Get the GTK+ widget, cast to 'Gtk.Widget', of /some/ state tree.
someStateWidget :: SomeState -> IO Gtk.Widget
someStateWidget :: SomeState -> IO Widget
someStateWidget (SomeState st :: StateTree stateType widget child event customState
st) = widget -> IO Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
Gtk.toWidget (StateTree stateType widget child event customState -> widget
forall (stateType :: StateType) widget (child :: * -> *) event
       customState.
StateTree stateType widget child event customState -> widget
stateTreeNodeWidget StateTree stateType widget child event customState
st)