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

Option button widget, used for choosing one value from a fixed set. Each
instance of optionButton is associated with a single value.

@
optionButton "First option" Option1 optionLens
@

Its behavior is equivalent to "Monomer.Widgets.Singles.Radio" and
"Monomer.Widgets.Singles.LabeledRadio", with a different visual representation.

This widget, and the associated "Monomer.Widgets.Singles.ToggleButton", uses two
separate styles for the On and Off states which can be modified individually for
the theme. If you use any of the the standard style functions (styleBasic,
styleHover, etc) in an optionButton/toggleButton these changes will apply to
both On and Off states, except for the color related styles. The reason is that,
in general, the font and padding will be the same for both states, but the
colors will differ. The 'optionButtonOffStyle' option, which receives a 'Style'
instance, can be used to change the colors of the Off state. The values set with
this option are higher priority than any inherited style from the theme or node
text style.

'Style' instances can be created this way:

@
newStyle :: Style = def
  \`styleBasic\` [textSize 20]
  \`styleHover\` [textColor white]
@
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StrictData #-}

module Monomer.Widgets.Singles.OptionButton (
  -- * Configuration
  OptionButtonValue,
  OptionButtonCfg,
  optionButtonOffStyle,
  -- * Constructors
  optionButton,
  optionButton_,
  optionButtonV,
  optionButtonV_,
  optionButtonD_,
  -- * Internal
  makeOptionButton
) where

import Control.Applicative ((<|>))
import Control.Lens (ALens', Lens', (&), (^.), (^?), (.~), (?~), _Just)
import Control.Monad
import Data.Default
import Data.Maybe
import Data.Text (Text)
import Data.Typeable (Typeable, typeOf)
import TextShow

import qualified Data.Sequence as Seq

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

import qualified Monomer.Lens as L

-- | Constraints for numeric types accepted by the optionButton widget.
type OptionButtonValue a = (Eq a, Typeable a)

{-|
Configuration options for optionButton:

- 'ignoreTheme': whether to load default style from theme or start empty.
- 'optionButtonOffStyle': style to use when the option is not active.
- '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.
- '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 the value is clicked.
- 'onClickReq': 'WidgetRequest' to generate when the value is clicked.
- 'onChange': event to raise when the value changes.
- 'onChangeReq': 'WidgetRequest' to generate when the value changes.
-}
data OptionButtonCfg s e a = OptionButtonCfg {
  forall s e a. OptionButtonCfg s e a -> Maybe Bool
_obcIgnoreTheme :: Maybe Bool,
  forall s e a. OptionButtonCfg s e a -> Maybe Style
_obcOffStyle :: Maybe Style,
  forall s e a. OptionButtonCfg s e a -> LabelCfg s e
_obcLabelCfg :: LabelCfg s e,
  forall s e a. OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
_obcOnFocusReq :: [Path -> WidgetRequest s e],
  forall s e a. OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
_obcOnBlurReq :: [Path -> WidgetRequest s e],
  forall s e a. OptionButtonCfg s e a -> [WidgetRequest s e]
_obcOnClickReq :: [WidgetRequest s e],
  forall s e a. OptionButtonCfg s e a -> [a -> WidgetRequest s e]
_obcOnChangeReq :: [a -> WidgetRequest s e]
}

instance Default (OptionButtonCfg s e a) where
  def :: OptionButtonCfg s e a
def = OptionButtonCfg {
    _obcIgnoreTheme :: Maybe Bool
_obcIgnoreTheme = forall a. Maybe a
Nothing,
    _obcOffStyle :: Maybe Style
_obcOffStyle = forall a. Maybe a
Nothing,
    _obcLabelCfg :: LabelCfg s e
_obcLabelCfg = forall a. Default a => a
def,
    _obcOnFocusReq :: [Path -> WidgetRequest s e]
_obcOnFocusReq = [],
    _obcOnBlurReq :: [Path -> WidgetRequest s e]
_obcOnBlurReq = [],
    _obcOnClickReq :: [WidgetRequest s e]
_obcOnClickReq = [],
    _obcOnChangeReq :: [a -> WidgetRequest s e]
_obcOnChangeReq = []
  }

instance Semigroup (OptionButtonCfg s e a) where
  <> :: OptionButtonCfg s e a
-> OptionButtonCfg s e a -> OptionButtonCfg s e a
(<>) OptionButtonCfg s e a
t1 OptionButtonCfg s e a
t2 = OptionButtonCfg {
    _obcIgnoreTheme :: Maybe Bool
_obcIgnoreTheme = forall s e a. OptionButtonCfg s e a -> Maybe Bool
_obcIgnoreTheme OptionButtonCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. OptionButtonCfg s e a -> Maybe Bool
_obcIgnoreTheme OptionButtonCfg s e a
t1,
    _obcOffStyle :: Maybe Style
_obcOffStyle = forall s e a. OptionButtonCfg s e a -> Maybe Style
_obcOffStyle OptionButtonCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. OptionButtonCfg s e a -> Maybe Style
_obcOffStyle OptionButtonCfg s e a
t2,
    _obcLabelCfg :: LabelCfg s e
_obcLabelCfg = forall s e a. OptionButtonCfg s e a -> LabelCfg s e
_obcLabelCfg OptionButtonCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. OptionButtonCfg s e a -> LabelCfg s e
_obcLabelCfg OptionButtonCfg s e a
t2,
    _obcOnFocusReq :: [Path -> WidgetRequest s e]
_obcOnFocusReq = forall s e a. OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
_obcOnFocusReq OptionButtonCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
_obcOnFocusReq OptionButtonCfg s e a
t2,
    _obcOnBlurReq :: [Path -> WidgetRequest s e]
_obcOnBlurReq = forall s e a. OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
_obcOnBlurReq OptionButtonCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
_obcOnBlurReq OptionButtonCfg s e a
t2,
    _obcOnClickReq :: [WidgetRequest s e]
_obcOnClickReq = forall s e a. OptionButtonCfg s e a -> [WidgetRequest s e]
_obcOnClickReq OptionButtonCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. OptionButtonCfg s e a -> [WidgetRequest s e]
_obcOnClickReq OptionButtonCfg s e a
t2,
    _obcOnChangeReq :: [a -> WidgetRequest s e]
_obcOnChangeReq = forall s e a. OptionButtonCfg s e a -> [a -> WidgetRequest s e]
_obcOnChangeReq OptionButtonCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. OptionButtonCfg s e a -> [a -> WidgetRequest s e]
_obcOnChangeReq OptionButtonCfg s e a
t2
  }

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

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

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

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

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

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

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

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

instance WidgetEvent e => CmbOnFocus (OptionButtonCfg s e a) e Path where
  onFocus :: (Path -> e) -> OptionButtonCfg s e a
onFocus Path -> e
fn = forall a. Default a => a
def {
    _obcOnFocusReq :: [Path -> WidgetRequest s e]
_obcOnFocusReq = [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 (OptionButtonCfg s e a) s e Path where
  onFocusReq :: (Path -> WidgetRequest s e) -> OptionButtonCfg s e a
onFocusReq Path -> WidgetRequest s e
req = forall a. Default a => a
def {
    _obcOnFocusReq :: [Path -> WidgetRequest s e]
_obcOnFocusReq = [Path -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnBlur (OptionButtonCfg s e a) e Path where
  onBlur :: (Path -> e) -> OptionButtonCfg s e a
onBlur Path -> e
fn = forall a. Default a => a
def {
    _obcOnBlurReq :: [Path -> WidgetRequest s e]
_obcOnBlurReq = [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 (OptionButtonCfg s e a) s e Path where
  onBlurReq :: (Path -> WidgetRequest s e) -> OptionButtonCfg s e a
onBlurReq Path -> WidgetRequest s e
req = forall a. Default a => a
def {
    _obcOnBlurReq :: [Path -> WidgetRequest s e]
_obcOnBlurReq = [Path -> WidgetRequest s e
req]
  }

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

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

instance WidgetEvent e => CmbOnChange (OptionButtonCfg s e a) a e where
  onChange :: (a -> e) -> OptionButtonCfg s e a
onChange a -> e
fn = forall a. Default a => a
def {
    _obcOnChangeReq :: [a -> WidgetRequest s e]
_obcOnChangeReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> e
fn]
  }

instance CmbOnChangeReq (OptionButtonCfg s e a) s e a where
  onChangeReq :: (a -> WidgetRequest s e) -> OptionButtonCfg s e a
onChangeReq a -> WidgetRequest s e
req = forall a. Default a => a
def {
    _obcOnChangeReq :: [a -> WidgetRequest s e]
_obcOnChangeReq = [a -> WidgetRequest s e
req]
  }

-- | Sets the style for the Off state of the option button.
optionButtonOffStyle :: Style -> OptionButtonCfg s e a
optionButtonOffStyle :: forall s e a. Style -> OptionButtonCfg s e a
optionButtonOffStyle Style
style = forall a. Default a => a
def {
  _obcOffStyle :: Maybe Style
_obcOffStyle = forall a. a -> Maybe a
Just Style
style
}

-- | Creates an optionButton using the given lens.
optionButton
  :: OptionButtonValue a
  => Text            -- ^ The caption.
  -> a               -- ^ The option value.
  -> ALens' s a      -- ^ The lens into the model.
  -> WidgetNode s e  -- ^ The created option button.
optionButton :: forall a s e.
OptionButtonValue a =>
Text -> a -> ALens' s a -> WidgetNode s e
optionButton Text
caption a
option ALens' s a
field = forall a s e.
OptionButtonValue a =>
Text
-> a -> ALens' s a -> [OptionButtonCfg s e a] -> WidgetNode s e
optionButton_ Text
caption a
option ALens' s a
field forall a. Default a => a
def

-- | Creates an optionButton using the given lens. Accepts config.
optionButton_
  :: OptionButtonValue a
  => Text                     -- ^ The caption.
  -> a                        -- ^ The option value.
  -> ALens' s a               -- ^ The lens into the model.
  -> [OptionButtonCfg s e a]  -- ^ The config options.
  -> WidgetNode s e           -- ^ The created option button.
optionButton_ :: forall a s e.
OptionButtonValue a =>
Text
-> a -> ALens' s a -> [OptionButtonCfg s e a] -> WidgetNode s e
optionButton_ Text
caption a
option ALens' s a
field [OptionButtonCfg s e a]
cfgs = WidgetNode s e
newNode where
  newNode :: WidgetNode s e
newNode = forall a s e.
OptionButtonValue a =>
Text
-> a -> WidgetData s a -> [OptionButtonCfg s e a] -> WidgetNode s e
optionButtonD_ Text
caption a
option (forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s a
field) [OptionButtonCfg s e a]
cfgs

-- | Creates an optionButton using the given value and 'onChange' event handler.
optionButtonV
  :: (OptionButtonValue a, WidgetEvent e)
  => Text            -- ^ The caption.
  -> a               -- ^ The option value.
  -> a               -- ^ The current value.
  -> (a -> e)        -- ^ The event to raise on change.
  -> WidgetNode s e  -- ^ The created option button.
optionButtonV :: forall a e s.
(OptionButtonValue a, WidgetEvent e) =>
Text -> a -> a -> (a -> e) -> WidgetNode s e
optionButtonV Text
caption a
option a
value a -> e
handler = forall {s}. WidgetNode s e
newNode where
  newNode :: WidgetNode s e
newNode = forall a e s.
(OptionButtonValue a, WidgetEvent e) =>
Text
-> a -> a -> (a -> e) -> [OptionButtonCfg s e a] -> WidgetNode s e
optionButtonV_ Text
caption a
option a
value a -> e
handler forall a. Default a => a
def

-- | Creates an optionButton using the given value and 'onChange' event handler.
--   Accepts config.
optionButtonV_
  :: (OptionButtonValue a, WidgetEvent e)
  => Text                     -- ^ The caption.
  -> a                        -- ^ The option value.
  -> a                        -- ^ The current value.
  -> (a -> e)                 -- ^ The event to raise on change.
  -> [OptionButtonCfg s e a]  -- ^ The config options.
  -> WidgetNode s e           -- ^ The created option button.
optionButtonV_ :: forall a e s.
(OptionButtonValue a, WidgetEvent e) =>
Text
-> a -> a -> (a -> e) -> [OptionButtonCfg s e a] -> WidgetNode s e
optionButtonV_ Text
caption a
option a
value a -> e
handler [OptionButtonCfg s e a]
configs = WidgetNode s e
newNode where
  widgetData :: WidgetData s a
widgetData = forall s a. a -> WidgetData s a
WidgetValue a
value
  newConfigs :: [OptionButtonCfg s e a]
newConfigs = forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange a -> e
handler forall a. a -> [a] -> [a]
: [OptionButtonCfg s e a]
configs
  newNode :: WidgetNode s e
newNode = forall a s e.
OptionButtonValue a =>
Text
-> a -> WidgetData s a -> [OptionButtonCfg s e a] -> WidgetNode s e
optionButtonD_ Text
caption a
option forall {s}. WidgetData s a
widgetData [OptionButtonCfg s e a]
newConfigs

-- | Creates an optionButton providing a 'WidgetData' instance and config.
optionButtonD_
  :: OptionButtonValue a
  => Text                     -- ^ The caption.
  -> a                        -- ^ The option value.
  -> WidgetData s a           -- ^ The 'WidgetData' to retrieve the value from.
  -> [OptionButtonCfg s e a]  -- ^ The config options.
  -> WidgetNode s e           -- ^ The created option button.
optionButtonD_ :: forall a s e.
OptionButtonValue a =>
Text
-> a -> WidgetData s a -> [OptionButtonCfg s e a] -> WidgetNode s e
optionButtonD_ Text
caption a
option WidgetData s a
widgetData [OptionButtonCfg s e a]
configs = WidgetNode s e
optionButtonNode where
  config :: OptionButtonCfg s e a
config = forall a. Monoid a => [a] -> a
mconcat [OptionButtonCfg s e a]
configs
  makeWithStyle :: WidgetData s a
-> Text
-> (a -> Bool)
-> (a -> a)
-> OptionButtonCfg s e a
-> Widget s e
makeWithStyle = forall a s e.
OptionButtonValue a =>
Lens' ThemeState StyleState
-> Lens' ThemeState StyleState
-> WidgetData s a
-> Text
-> (a -> Bool)
-> (a -> a)
-> OptionButtonCfg s e a
-> Widget s e
makeOptionButton forall s a. HasOptionBtnOnStyle s a => Lens' s a
L.optionBtnOnStyle forall s a. HasOptionBtnOffStyle s a => Lens' s a
L.optionBtnOffStyle
  wtype :: WidgetType
wtype = Text -> WidgetType
WidgetType (Text
"optionButton-" forall a. Semigroup a => a -> a -> a
<> forall a. TextShow a => a -> Text
showt (forall a. Typeable a => a -> TypeRep
typeOf a
option))
  widget :: Widget s e
widget = forall {s} {e}.
WidgetData s a
-> Text
-> (a -> Bool)
-> (a -> a)
-> OptionButtonCfg s e a
-> Widget s e
makeWithStyle WidgetData s a
widgetData Text
caption (forall a. Eq a => a -> a -> Bool
== a
option) (forall a b. a -> b -> a
const a
option) OptionButtonCfg s e a
config
  optionButtonNode :: WidgetNode s e
optionButtonNode = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
wtype 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

{-|
Helper function for creating a button associated to a value. Used by
_optionButton_ and _toggleButton_.
-}
makeOptionButton
  :: OptionButtonValue a
  => Lens' ThemeState StyleState  -- ^ The on style lens.
  -> Lens' ThemeState StyleState  -- ^ The off style lens.
  -> WidgetData s a               -- ^ The 'WidgetData' to retrieve the value from.
  -> Text                         -- ^ The caption.
  -> (a -> Bool)                  -- ^ Set the on or off state depending on the value.
  -> (a -> a)                     -- ^ How to change the value on click.
  -> OptionButtonCfg s e a        -- ^ The config.
  -> Widget s e                   -- ^ The created widget.
makeOptionButton :: forall a s e.
OptionButtonValue a =>
Lens' ThemeState StyleState
-> Lens' ThemeState StyleState
-> WidgetData s a
-> Text
-> (a -> Bool)
-> (a -> a)
-> OptionButtonCfg s e a
-> Widget s e
makeOptionButton Lens' ThemeState StyleState
styleOn Lens' ThemeState StyleState
styleOff !WidgetData s a
field !Text
caption !a -> Bool
isSelVal !a -> a
getNextVal !OptionButtonCfg s e a
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,
    containerInit :: ContainerInitHandler s e
containerInit = forall {e}. WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
init,
    containerMerge :: ContainerMergeHandler s e ()
containerMerge = forall {e} {p} {p}.
WidgetEnv s e -> 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
  }

  createChildNode :: WidgetEnv s e -> p -> p
createChildNode WidgetEnv s e
wenv p
node = p
newNode where
    currValue :: a
currValue = forall s a. s -> WidgetData s a -> a
widgetDataGet (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasModel s a => Lens' s a
L.model) WidgetData s a
field
    isSelected :: Bool
isSelected = a -> Bool
isSelVal a
currValue
    useBaseTheme :: Bool
useBaseTheme = forall s e a. OptionButtonCfg s e a -> Maybe Bool
_obcIgnoreTheme OptionButtonCfg s e a
config forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Bool
True

    baseOffStyle :: Maybe Style
baseOffStyle
      | Bool
useBaseTheme = forall a. a -> Maybe a
Just (forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv Lens' ThemeState StyleState
styleOff)
      | Bool
otherwise = forall a. Maybe a
Nothing

    baseOnStyle :: Maybe Style
baseOnStyle
      | Bool
useBaseTheme = forall a. a -> Maybe a
Just (forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv Lens' ThemeState StyleState
styleOn)
      | Bool
otherwise = forall a. Maybe a
Nothing

    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
    colorlessStyle :: Style
colorlessStyle = (StyleState -> StyleState) -> Style -> Style
mapStyleStates StyleState -> StyleState
resetColor Style
nodeStyle
    customOffStyle :: Maybe Style
customOffStyle = Style -> Style
mergeBasicStyle forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s e a. OptionButtonCfg s e a -> Maybe Style
_obcOffStyle OptionButtonCfg s e a
config

    labelNodeStyle :: Style
labelNodeStyle
      | Bool
isSelected = forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Style
baseOnStyle forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just Style
nodeStyle)
      | Bool
otherwise = forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Style
baseOffStyle forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just Style
colorlessStyle forall a. Semigroup a => a -> a -> a
<> Maybe Style
customOffStyle)

    labelCfg :: LabelCfg s e
labelCfg = forall s e a. OptionButtonCfg s e a -> LabelCfg s e
_obcLabelCfg OptionButtonCfg s e a
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
labelNodeStyle

    !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 :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
init WidgetEnv s e
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} {e}.
(HasInfo p a, HasStyle a Style,
 HasChildren p (Seq (WidgetNode s e))) =>
WidgetEnv s e -> p -> p
createChildNode WidgetEnv s e
wenv WidgetNode s e
node)

  merge :: WidgetEnv s e -> WidgetNode s e -> p -> p -> WidgetResult s e
merge WidgetEnv s e
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} {e}.
(HasInfo p a, HasStyle a Style,
 HasChildren p (Seq (WidgetNode s e))) =>
WidgetEnv s e -> p -> p
createChildNode WidgetEnv s e
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 a. OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
_obcOnFocusReq OptionButtonCfg s e a
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 a. OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
_obcOnBlurReq OptionButtonCfg s e a
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

      currValue :: a
currValue = forall s a. s -> WidgetData s a -> a
widgetDataGet (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasModel s a => Lens' s a
L.model) WidgetData s a
field
      nextValue :: a
nextValue = a -> a
getNextVal a
currValue
      setValueReq :: [WidgetRequest s e]
setValueReq = forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetData s a
field a
nextValue
      clickReqs :: [WidgetRequest s e]
clickReqs = forall s e a. OptionButtonCfg s e a -> [WidgetRequest s e]
_obcOnClickReq OptionButtonCfg s e a
config
      changeReqs :: [WidgetRequest s e]
changeReqs
        | a
currValue forall a. Eq a => a -> a -> Bool
/= a
nextValue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ a
nextValue) (forall s e a. OptionButtonCfg s e a -> [a -> WidgetRequest s e]
_obcOnChangeReq OptionButtonCfg s e a
config)
        | Bool
otherwise = []
      reqs :: [WidgetRequest s e]
reqs = forall {e}. [WidgetRequest s e]
setValueReq forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
clickReqs forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
changeReqs
      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)

resetColor :: StyleState -> StyleState
resetColor :: StyleState -> StyleState
resetColor StyleState
st = StyleState
st
  forall a b. a -> (a -> b) -> b
& forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing
  forall a b. a -> (a -> b) -> b
& forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing
  forall a b. a -> (a -> b) -> b
& forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFontColor s a => Lens' s a
L.fontColor forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing