{-|
Module      : Monomer.Widgets.Singles.Button
Copyright   : (c) 2018 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Button widget, with support for multiline text. At the most basic level, a
button consists of a caption and an event to raise when clicked.

@
button "Increase count" AppIncrease
@
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StrictData #-}

module Monomer.Widgets.Singles.Button (
  -- * Configuration
  ButtonCfg,
  -- * Constructors
  mainButton,
  mainButton_,
  mainButtonD_,
  button,
  button_,
  buttonD_
) where

import Control.Applicative ((<|>))
import Control.Lens ((&), (^.), (.~))
import Data.Default
import Data.Maybe
import Data.Text (Text)

import qualified Data.Sequence as Seq

import Monomer.Widgets.Container
import Monomer.Widgets.Singles.Label

import qualified Monomer.Lens as L

data ButtonType
  = ButtonNormal
  | ButtonMain
  deriving (ButtonType -> ButtonType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ButtonType -> ButtonType -> Bool
$c/= :: ButtonType -> ButtonType -> Bool
== :: ButtonType -> ButtonType -> Bool
$c== :: ButtonType -> ButtonType -> Bool
Eq, Int -> ButtonType -> ShowS
[ButtonType] -> ShowS
ButtonType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ButtonType] -> ShowS
$cshowList :: [ButtonType] -> ShowS
show :: ButtonType -> String
$cshow :: ButtonType -> String
showsPrec :: Int -> ButtonType -> ShowS
$cshowsPrec :: Int -> ButtonType -> ShowS
Show)

{-|
Configuration options for button:

- 'ignoreParentEvts': whether to ignore all other responses to the click or
  keypress that triggered the button, and only keep this button's response.
  Useful when the button is child of a _keystroke_ widget.
- 'trimSpaces': whether to remove leading/trailing spaces in the caption.
- 'ellipsis': if ellipsis should be used for overflown text.
- 'multiline': if text may be split in multiple lines.
- 'maxLines': maximum number of text lines to show.
- 'ignoreTheme': whether to load default style from theme or start empty.
- 'resizeFactor': flexibility to have more or less spaced assigned.
- 'resizeFactorW': flexibility to have more or less horizontal spaced assigned.
- 'resizeFactorH': flexibility to have more or less vertical spaced assigned.
- 'onFocus': event to raise when focus is received.
- 'onFocusReq': 'WidgetRequest' to generate when focus is received.
- 'onBlur': event to raise when focus is lost.
- 'onBlurReq': 'WidgetRequest' to generate when focus is lost.
- 'onClick': event to raise when button is clicked.
- 'onClickReq': 'WidgetRequest' to generate when button is clicked.
-}
data ButtonCfg s e = ButtonCfg {
  forall s e. ButtonCfg s e -> Maybe ButtonType
_btnButtonType :: Maybe ButtonType,
  forall s e. ButtonCfg s e -> Maybe Bool
_btnIgnoreParent :: Maybe Bool,
  forall s e. ButtonCfg s e -> Maybe Bool
_btnIgnoreTheme :: Maybe Bool,
  forall s e. ButtonCfg s e -> LabelCfg s e
_btnLabelCfg :: LabelCfg s e,
  forall s e. ButtonCfg s e -> [Path -> WidgetRequest s e]
_btnOnFocusReq :: [Path -> WidgetRequest s e],
  forall s e. ButtonCfg s e -> [Path -> WidgetRequest s e]
_btnOnBlurReq :: [Path -> WidgetRequest s e],
  forall s e. ButtonCfg s e -> [WidgetRequest s e]
_btnOnClickReq :: [WidgetRequest s e]
}

instance Default (ButtonCfg s e) where
  def :: ButtonCfg s e
def = ButtonCfg {
    _btnButtonType :: Maybe ButtonType
_btnButtonType = forall a. Maybe a
Nothing,
    _btnIgnoreParent :: Maybe Bool
_btnIgnoreParent = forall a. Maybe a
Nothing,
    _btnIgnoreTheme :: Maybe Bool
_btnIgnoreTheme = forall a. Maybe a
Nothing,
    _btnLabelCfg :: LabelCfg s e
_btnLabelCfg = forall a. Default a => a
def,
    _btnOnFocusReq :: [Path -> WidgetRequest s e]
_btnOnFocusReq = [],
    _btnOnBlurReq :: [Path -> WidgetRequest s e]
_btnOnBlurReq = [],
    _btnOnClickReq :: [WidgetRequest s e]
_btnOnClickReq = []
  }

instance Semigroup (ButtonCfg s e) where
  <> :: ButtonCfg s e -> ButtonCfg s e -> ButtonCfg s e
(<>) ButtonCfg s e
t1 ButtonCfg s e
t2 = ButtonCfg {
    _btnButtonType :: Maybe ButtonType
_btnButtonType = forall s e. ButtonCfg s e -> Maybe ButtonType
_btnButtonType ButtonCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. ButtonCfg s e -> Maybe ButtonType
_btnButtonType ButtonCfg s e
t1,
    _btnIgnoreParent :: Maybe Bool
_btnIgnoreParent = forall s e. ButtonCfg s e -> Maybe Bool
_btnIgnoreParent ButtonCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. ButtonCfg s e -> Maybe Bool
_btnIgnoreParent ButtonCfg s e
t1,
    _btnIgnoreTheme :: Maybe Bool
_btnIgnoreTheme = forall s e. ButtonCfg s e -> Maybe Bool
_btnIgnoreTheme ButtonCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. ButtonCfg s e -> Maybe Bool
_btnIgnoreTheme ButtonCfg s e
t1,
    _btnLabelCfg :: LabelCfg s e
_btnLabelCfg = forall s e. ButtonCfg s e -> LabelCfg s e
_btnLabelCfg ButtonCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. ButtonCfg s e -> LabelCfg s e
_btnLabelCfg ButtonCfg s e
t2,
    _btnOnFocusReq :: [Path -> WidgetRequest s e]
_btnOnFocusReq = forall s e. ButtonCfg s e -> [Path -> WidgetRequest s e]
_btnOnFocusReq ButtonCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. ButtonCfg s e -> [Path -> WidgetRequest s e]
_btnOnFocusReq ButtonCfg s e
t2,
    _btnOnBlurReq :: [Path -> WidgetRequest s e]
_btnOnBlurReq = forall s e. ButtonCfg s e -> [Path -> WidgetRequest s e]
_btnOnBlurReq ButtonCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. ButtonCfg s e -> [Path -> WidgetRequest s e]
_btnOnBlurReq ButtonCfg s e
t2,
    _btnOnClickReq :: [WidgetRequest s e]
_btnOnClickReq = forall s e. ButtonCfg s e -> [WidgetRequest s e]
_btnOnClickReq ButtonCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. ButtonCfg s e -> [WidgetRequest s e]
_btnOnClickReq ButtonCfg s e
t2
  }

instance Monoid (ButtonCfg s e) where
  mempty :: ButtonCfg s e
mempty = forall a. Default a => a
def

instance CmbIgnoreParentEvts (ButtonCfg s e) where
  ignoreParentEvts_ :: Bool -> ButtonCfg s e
ignoreParentEvts_ Bool
ignore = forall a. Default a => a
def {
    _btnIgnoreParent :: Maybe Bool
_btnIgnoreParent = forall a. a -> Maybe a
Just Bool
ignore
  }

instance CmbIgnoreTheme (ButtonCfg s e) where
  ignoreTheme_ :: Bool -> ButtonCfg s e
ignoreTheme_ Bool
ignore = forall a. Default a => a
def {
    _btnIgnoreTheme :: Maybe Bool
_btnIgnoreTheme = forall a. a -> Maybe a
Just Bool
ignore
  }

instance CmbTrimSpaces (ButtonCfg s e) where
  trimSpaces_ :: Bool -> ButtonCfg s e
trimSpaces_ Bool
trim = forall a. Default a => a
def {
    _btnLabelCfg :: LabelCfg s e
_btnLabelCfg = forall t. CmbTrimSpaces t => Bool -> t
trimSpaces_ Bool
trim
  }

instance CmbEllipsis (ButtonCfg s e) where
  ellipsis_ :: Bool -> ButtonCfg s e
ellipsis_ Bool
ellipsis = forall a. Default a => a
def {
    _btnLabelCfg :: LabelCfg s e
_btnLabelCfg = forall t. CmbEllipsis t => Bool -> t
ellipsis_ Bool
ellipsis
  }

instance CmbMultiline (ButtonCfg s e) where
  multiline_ :: Bool -> ButtonCfg s e
multiline_ Bool
multi = forall a. Default a => a
def {
    _btnLabelCfg :: LabelCfg s e
_btnLabelCfg = forall t. CmbMultiline t => Bool -> t
multiline_ Bool
multi
  }

instance CmbMaxLines (ButtonCfg s e) where
  maxLines :: Int -> ButtonCfg s e
maxLines Int
count = forall a. Default a => a
def {
    _btnLabelCfg :: LabelCfg s e
_btnLabelCfg = forall t. CmbMaxLines t => Int -> t
maxLines Int
count
  }

instance CmbResizeFactor (ButtonCfg s e) where
  resizeFactor :: Double -> ButtonCfg s e
resizeFactor Double
s = forall a. Default a => a
def {
    _btnLabelCfg :: LabelCfg s e
_btnLabelCfg = forall t. CmbResizeFactor t => Double -> t
resizeFactor Double
s
  }

instance CmbResizeFactorDim (ButtonCfg s e) where
  resizeFactorW :: Double -> ButtonCfg s e
resizeFactorW Double
w = forall a. Default a => a
def {
    _btnLabelCfg :: LabelCfg s e
_btnLabelCfg = forall t. CmbResizeFactorDim t => Double -> t
resizeFactorW Double
w
  }
  resizeFactorH :: Double -> ButtonCfg s e
resizeFactorH Double
h = forall a. Default a => a
def {
    _btnLabelCfg :: LabelCfg s e
_btnLabelCfg = forall t. CmbResizeFactorDim t => Double -> t
resizeFactorH Double
h
  }

instance WidgetEvent e => CmbOnFocus (ButtonCfg s e) e Path where
  onFocus :: (Path -> e) -> ButtonCfg s e
onFocus Path -> e
fn = forall a. Default a => a
def {
    _btnOnFocusReq :: [Path -> WidgetRequest s e]
_btnOnFocusReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
fn]
  }

instance CmbOnFocusReq (ButtonCfg s e) s e Path where
  onFocusReq :: (Path -> WidgetRequest s e) -> ButtonCfg s e
onFocusReq Path -> WidgetRequest s e
req = forall a. Default a => a
def {
    _btnOnFocusReq :: [Path -> WidgetRequest s e]
_btnOnFocusReq = [Path -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnBlur (ButtonCfg s e) e Path where
  onBlur :: (Path -> e) -> ButtonCfg s e
onBlur Path -> e
fn = forall a. Default a => a
def {
    _btnOnBlurReq :: [Path -> WidgetRequest s e]
_btnOnBlurReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
fn]
  }

instance CmbOnBlurReq (ButtonCfg s e) s e Path where
  onBlurReq :: (Path -> WidgetRequest s e) -> ButtonCfg s e
onBlurReq Path -> WidgetRequest s e
req = forall a. Default a => a
def {
    _btnOnBlurReq :: [Path -> WidgetRequest s e]
_btnOnBlurReq = [Path -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnClick (ButtonCfg s e) e where
  onClick :: e -> ButtonCfg s e
onClick e
handler = forall a. Default a => a
def {
    _btnOnClickReq :: [WidgetRequest s e]
_btnOnClickReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent e
handler]
  }

instance CmbOnClickReq (ButtonCfg s e) s e where
  onClickReq :: WidgetRequest s e -> ButtonCfg s e
onClickReq WidgetRequest s e
req = forall a. Default a => a
def {
    _btnOnClickReq :: [WidgetRequest s e]
_btnOnClickReq = [WidgetRequest s e
req]
  }

mainConfig :: ButtonCfg s e
mainConfig :: forall s e. ButtonCfg s e
mainConfig = forall a. Default a => a
def {
  _btnButtonType :: Maybe ButtonType
_btnButtonType = forall a. a -> Maybe a
Just ButtonType
ButtonMain
}

{-|
Creates a button with main styling. Useful to highlight an option, such as
\"Accept\", when multiple buttons are available.
-}
mainButton
  :: WidgetEvent e
  => Text            -- ^ The caption.
  -> e               -- ^ The event to raise on click.
  -> WidgetNode s e  -- ^ The created button.
mainButton :: forall e s. WidgetEvent e => Text -> e -> WidgetNode s e
mainButton Text
caption e
handler = forall e s.
WidgetEvent e =>
Text -> e -> [ButtonCfg s e] -> WidgetNode s e
button_ Text
caption e
handler [forall s e. ButtonCfg s e
mainConfig]

{-|
Creates a button with main styling. Useful to highlight an option, such as
\"Accept\", when multiple buttons are available. Accepts config.
-}
mainButton_
  :: WidgetEvent e
  => Text             -- ^ The caption.
  -> e                -- ^ The event to raise on click.
  -> [ButtonCfg s e]  -- ^ The config options.
  -> WidgetNode s e   -- ^ The created button.
mainButton_ :: forall e s.
WidgetEvent e =>
Text -> e -> [ButtonCfg s e] -> WidgetNode s e
mainButton_ Text
caption e
handler [ButtonCfg s e]
configs = forall e s.
WidgetEvent e =>
Text -> e -> [ButtonCfg s e] -> WidgetNode s e
button_ Text
caption e
handler [ButtonCfg s e]
newConfigs where
  newConfigs :: [ButtonCfg s e]
newConfigs = forall s e. ButtonCfg s e
mainConfig forall a. a -> [a] -> [a]
: [ButtonCfg s e]
configs

{-|
Creates a button with main styling. Useful to highlight an option, such as
\"Accept\", when multiple buttons are available. Accepts config but does not
require an event. See 'buttonD_'.
-}
mainButtonD_
  :: WidgetEvent e
  => Text             -- ^ The caption.
  -> [ButtonCfg s e]  -- ^ The config options.
  -> WidgetNode s e   -- ^ The created button.
mainButtonD_ :: forall e s.
WidgetEvent e =>
Text -> [ButtonCfg s e] -> WidgetNode s e
mainButtonD_ Text
caption [ButtonCfg s e]
configs = forall e s.
WidgetEvent e =>
Text -> [ButtonCfg s e] -> WidgetNode s e
buttonD_ Text
caption [ButtonCfg s e]
newConfigs where
  newConfigs :: [ButtonCfg s e]
newConfigs = forall s e. ButtonCfg s e
mainConfig forall a. a -> [a] -> [a]
: [ButtonCfg s e]
configs

-- | Creates a button with normal styling.
button
  :: WidgetEvent e
  => Text            -- ^ The caption.
  -> e               -- ^ The event to raise on click.
  -> WidgetNode s e  -- ^ The created button.
button :: forall e s. WidgetEvent e => Text -> e -> WidgetNode s e
button Text
caption e
handler = forall e s.
WidgetEvent e =>
Text -> e -> [ButtonCfg s e] -> WidgetNode s e
button_ Text
caption e
handler forall a. Default a => a
def

-- | Creates a button with normal styling. Accepts config.
button_
  :: WidgetEvent e
  => Text             -- ^ The caption.
  -> e                -- ^ The event to raise on click.
  -> [ButtonCfg s e]  -- ^ The config options.
  -> WidgetNode s e   -- ^ The created button.
button_ :: forall e s.
WidgetEvent e =>
Text -> e -> [ButtonCfg s e] -> WidgetNode s e
button_ Text
caption e
handler [ButtonCfg s e]
configs = WidgetNode s e
buttonNode where
  buttonNode :: WidgetNode s e
buttonNode = forall e s.
WidgetEvent e =>
Text -> [ButtonCfg s e] -> WidgetNode s e
buttonD_ Text
caption (forall t e. CmbOnClick t e => e -> t
onClick e
handler forall a. a -> [a] -> [a]
: [ButtonCfg s e]
configs)

{-|
Creates a button without forcing an event to be provided. The other constructors
use this version, adding an 'onClick' handler in configs.

Using this constructor directly can be helpful in cases where the event to be
raised belongs in a "Monomer.Widgets.Composite" above in the widget tree,
outside the scope of the Composite that contains the button. This parent
Composite can be reached by sending a message ('SendMessage') to its 'WidgetId'
using 'onClickReq'.
-}
buttonD_
  :: WidgetEvent e
  => Text             -- ^ The caption.
  -> [ButtonCfg s e]  -- ^ The config options.
  -> WidgetNode s e   -- ^ The created button.
buttonD_ :: forall e s.
WidgetEvent e =>
Text -> [ButtonCfg s e] -> WidgetNode s e
buttonD_ Text
caption [ButtonCfg s e]
configs = WidgetNode s e
buttonNode where
  config :: ButtonCfg s e
config = forall a. Monoid a => [a] -> a
mconcat [ButtonCfg s e]
configs
  widget :: Widget s e
widget = forall e s. WidgetEvent e => Text -> ButtonCfg s e -> Widget s e
makeButton Text
caption ButtonCfg s e
config
  !buttonNode :: WidgetNode s e
buttonNode = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"button" Widget s e
widget
    forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFocusable s a => Lens' s a
L.focusable forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True

makeButton :: WidgetEvent e => Text -> ButtonCfg s e -> Widget s e
makeButton :: forall e s. WidgetEvent e => Text -> ButtonCfg s e -> Widget s e
makeButton !Text
caption !ButtonCfg s e
config = Widget s e
widget where
  widget :: Widget s e
widget = forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer () forall a. Default a => a
def {
    containerAddStyleReq :: Bool
containerAddStyleReq = Bool
False,
    containerDrawDecorations :: Bool
containerDrawDecorations = Bool
False,
    containerUseScissor :: Bool
containerUseScissor = Bool
True,
    containerGetBaseStyle :: ContainerGetBaseStyle s e
containerGetBaseStyle = forall {s} {e} {p}. WidgetEnv s e -> p -> Maybe Style
getBaseStyle,
    containerInit :: ContainerInitHandler s e
containerInit = forall {p}. p -> WidgetNode s e -> WidgetResult s e
init,
    containerMerge :: ContainerMergeHandler s e ()
containerMerge = forall {p} {p} {p}.
p -> WidgetNode s e -> p -> p -> WidgetResult s e
merge,
    containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = forall {p}.
WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
    containerResize :: ContainerResizeHandler s e
containerResize = forall {p} {s} {e} {p} {p}.
p -> WidgetNode s e -> p -> p -> (WidgetResult s e, Seq p)
resize
  }

  !buttonType :: ButtonType
buttonType = forall a. a -> Maybe a -> a
fromMaybe ButtonType
ButtonNormal (forall s e. ButtonCfg s e -> Maybe ButtonType
_btnButtonType ButtonCfg s e
config)

  getBaseStyle :: WidgetEnv s e -> p -> Maybe Style
getBaseStyle WidgetEnv s e
wenv p
node
    | Bool
ignoreTheme = forall a. Maybe a
Nothing
    | Bool
otherwise = case ButtonType
buttonType of
        ButtonType
ButtonNormal -> forall a. a -> Maybe a
Just (forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasBtnStyle s a => Lens' s a
L.btnStyle)
        ButtonType
ButtonMain -> forall a. a -> Maybe a
Just (forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasBtnMainStyle s a => Lens' s a
L.btnMainStyle)
    where
      ignoreTheme :: Bool
ignoreTheme = forall s e. ButtonCfg s e -> Maybe Bool
_btnIgnoreTheme ButtonCfg s e
config forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True

  createChildNode :: p -> p -> p
createChildNode p
wenv p
node = p
newNode where
    nodeStyle :: Style
nodeStyle = p
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasStyle s a => Lens' s a
L.style
    labelCfg :: LabelCfg s e
labelCfg = forall s e. ButtonCfg s e -> LabelCfg s e
_btnLabelCfg ButtonCfg s e
config
    labelCurrStyle :: LabelCfg s e
labelCurrStyle = forall s e.
(WidgetEnv s e -> WidgetNode s e -> StyleState) -> LabelCfg s e
labelCurrentStyle forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
childOfFocusedStyle
    !labelNode :: WidgetNode s e
labelNode = forall s e. Text -> [LabelCfg s e] -> WidgetNode s e
label_ Text
caption [forall t. CmbIgnoreTheme t => t
ignoreTheme, LabelCfg s e
labelCfg, forall {s} {e}. LabelCfg s e
labelCurrStyle]
      forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasStyle s a => Lens' s a
L.style forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
nodeStyle
    !newNode :: p
newNode = p
node
      forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Seq a
Seq.singleton WidgetNode s e
labelNode

  init :: p -> WidgetNode s e -> WidgetResult s e
init p
wenv WidgetNode s e
node = WidgetResult s e
result where
    result :: WidgetResult s e
result = forall s e. WidgetNode s e -> WidgetResult s e
resultNode (forall {p} {a} {p}.
(HasInfo p a, HasStyle a Style,
 HasChildren p (Seq (WidgetNode s e))) =>
p -> p -> p
createChildNode p
wenv WidgetNode s e
node)

  merge :: p -> WidgetNode s e -> p -> p -> WidgetResult s e
merge p
wenv WidgetNode s e
node p
oldNode p
oldState = WidgetResult s e
result where
    result :: WidgetResult s e
result = forall s e. WidgetNode s e -> WidgetResult s e
resultNode (forall {p} {a} {p}.
(HasInfo p a, HasStyle a Style,
 HasChildren p (Seq (WidgetNode s e))) =>
p -> p -> p
createChildNode p
wenv WidgetNode s e
node)

  handleEvent :: WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent WidgetEnv s e
wenv WidgetNode s e
node p
target SystemEvent
evt = case SystemEvent
evt of
    Focus Path
prev -> forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
prev (forall s e. ButtonCfg s e -> [Path -> WidgetRequest s e]
_btnOnFocusReq ButtonCfg s e
config)
    Blur Path
next -> forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
next (forall s e. ButtonCfg s e -> [Path -> WidgetRequest s e]
_btnOnBlurReq ButtonCfg s e
config)

    KeyAction KeyMod
mode KeyCode
code KeyStatus
status
      | KeyCode -> Bool
isSelectKey KeyCode
code Bool -> Bool -> Bool
&& KeyStatus
status forall a. Eq a => a -> a -> Bool
== KeyStatus
KeyPressed -> forall a. a -> Maybe a
Just WidgetResult s e
result
      where
        isSelectKey :: KeyCode -> Bool
isSelectKey KeyCode
code = KeyCode -> Bool
isKeyReturn KeyCode
code Bool -> Bool -> Bool
|| KeyCode -> Bool
isKeySpace KeyCode
code

    Click Point
p Button
_ Int
_
      | forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
node Point
p -> forall a. a -> Maybe a
Just WidgetResult s e
result

    ButtonAction Point
p Button
btn ButtonState
BtnPressed Int
1 -- Set focus on click
      | Button -> Bool
mainBtn Button
btn Bool -> Bool -> Bool
&& Point -> Bool
pointInVp Point
p Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
focused -> forall a. a -> Maybe a
Just WidgetResult s e
resultFocus

    SystemEvent
_ -> forall a. Maybe a
Nothing
    where
      mainBtn :: Button -> Bool
mainBtn Button
btn = Button
btn forall a. Eq a => a -> a -> Bool
== WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasMainButton s a => Lens' s a
L.mainButton

      focused :: Bool
focused = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
node
      pointInVp :: Point -> Bool
pointInVp Point
p = forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
node Point
p
      ignoreParent :: Bool
ignoreParent = forall s e. ButtonCfg s e -> Maybe Bool
_btnIgnoreParent ButtonCfg s e
config forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True

      reqs :: [WidgetRequest s e]
reqs = forall s e. ButtonCfg s e -> [WidgetRequest s e]
_btnOnClickReq ButtonCfg s e
config forall a. [a] -> [a] -> [a]
++ [forall s e. WidgetRequest s e
IgnoreParentEvents | Bool
ignoreParent]
      result :: WidgetResult s e
result = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs
      resultFocus :: WidgetResult s e
resultFocus = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. WidgetId -> WidgetRequest s e
SetFocus (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId)]

  resize :: p -> WidgetNode s e -> p -> p -> (WidgetResult s e, Seq p)
resize p
wenv WidgetNode s e
node p
viewport p
children = (WidgetResult s e, Seq p)
resized where
    assignedAreas :: Seq p
assignedAreas = forall a. [a] -> Seq a
Seq.fromList [p
viewport]
    resized :: (WidgetResult s e, Seq p)
resized = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, Seq p
assignedAreas)