{-# LANGUAGE TemplateHaskell #-}
module Simple.UI.Widgets.Window (
WindowType (..),
Window,
WindowClass,
castToWindow,
windowNew,
windowType,
windowFocus
) where
import Control.Lens (makeLensesFor, (.=))
import Simple.UI.Core.Internal.UIApp
import Simple.UI.Core.Attribute
import Simple.UI.Widgets.Container
import Simple.UI.Widgets.Widget
data WindowType = WindowTypeTopLevel
| WindowTypeDialog
deriving (Eq, Show)
data Window a = Window
{ _windowParent :: Container a
, _windowType :: WindowType
, _windowFocus :: Attribute Bool
}
makeLensesFor [("_windowParent", "windowParent")] ''Window
class ContainerClass w => WindowClass w where
castToWindow :: w a -> Window a
windowType :: WindowClass w => w a -> WindowType
windowType = _windowType . castToWindow
windowFocus :: WindowClass w => w a -> Attribute Bool
windowFocus = _windowFocus . castToWindow
instance WindowClass Window where
castToWindow = id
instance ContainerClass Window where
castToContainer = _windowParent
instance WidgetClass (Window a) where
castToWidget = castToWidget . castToContainer
overrideWidget = overrideWidgetHelper windowParent
windowNew :: LayoutClass a => WindowType -> a -> UIApp u (Window a)
windowNew = windowNewOverride
windowNewOverride :: LayoutClass a => WindowType -> a -> UIApp u (Window a)
windowNewOverride t _layout = override <$> windowNewDefault t _layout
where
override window = overrideWidget window $
virtualWidgetName .= "window"
windowNewDefault :: LayoutClass a => WindowType -> a -> UIApp u (Window a)
windowNewDefault t _layout = do
parent <- containerNew _layout
focusLens <- attributeNew False
return Window
{ _windowParent = parent
, _windowType = t
, _windowFocus = focusLens
}