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

Toggle button widget, used for boolean values.

@
toggleButton \"Toggle\" booleanLens
@

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

See "Monomer.Widgets.Singles.OptionButton" for detailed notes.
-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StrictData #-}

module Monomer.Widgets.Singles.ToggleButton (
  -- * Configuration
  ToggleButtonCfg,
  toggleButtonOffStyle,
  -- * Constructors
  toggleButton,
  toggleButton_,
  toggleButtonV,
  toggleButtonV_,
  toggleButtonD_
) where

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

import qualified Data.Sequence as Seq

import Monomer.Widgets.Single
import Monomer.Widgets.Singles.OptionButton

import qualified Monomer.Lens as L

{-|
Configuration options for toggleButton:

- 'ignoreTheme': whether to load default style from theme or start empty.
- 'toggleButtonOffStyle': 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.
-}
type ToggleButtonCfg = OptionButtonCfg

-- | Sets the style for the Off state of the toggle button.
toggleButtonOffStyle :: Style -> ToggleButtonCfg s e a
toggleButtonOffStyle :: Style -> ToggleButtonCfg s e a
toggleButtonOffStyle = Style -> ToggleButtonCfg s e a
forall s e a. Style -> OptionButtonCfg s e a
optionButtonOffStyle

-- | Creates a toggleButton using the given lens.
toggleButton
  :: Text
  -> ALens' s Bool
  -> WidgetNode s e
toggleButton :: Text -> ALens' s Bool -> WidgetNode s e
toggleButton Text
caption ALens' s Bool
field = Text
-> ALens' s Bool -> [ToggleButtonCfg s e Bool] -> WidgetNode s e
forall s e.
Text
-> ALens' s Bool -> [ToggleButtonCfg s e Bool] -> WidgetNode s e
toggleButton_ Text
caption ALens' s Bool
field [ToggleButtonCfg s e Bool]
forall a. Default a => a
def

-- | Creates a toggleButton using the given lens. Accepts config.
toggleButton_
  :: Text
  -> ALens' s Bool
  -> [ToggleButtonCfg s e Bool]
  -> WidgetNode s e
toggleButton_ :: Text
-> ALens' s Bool -> [ToggleButtonCfg s e Bool] -> WidgetNode s e
toggleButton_ Text
caption ALens' s Bool
field [ToggleButtonCfg s e Bool]
cfgs = WidgetNode s e
newNode where
  newNode :: WidgetNode s e
newNode = Text
-> WidgetData s Bool
-> [ToggleButtonCfg s e Bool]
-> WidgetNode s e
forall s e.
Text
-> WidgetData s Bool
-> [ToggleButtonCfg s e Bool]
-> WidgetNode s e
toggleButtonD_ Text
caption (ALens' s Bool -> WidgetData s Bool
forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s Bool
field) [ToggleButtonCfg s e Bool]
cfgs

-- | Creates a toggleButton using the given value and 'onChange' event handler.
toggleButtonV
  :: WidgetEvent e
  => Text
  -> Bool
  -> (Bool -> e)
  -> WidgetNode s e
toggleButtonV :: Text -> Bool -> (Bool -> e) -> WidgetNode s e
toggleButtonV Text
caption Bool
value Bool -> e
handler = WidgetNode s e
forall s. WidgetNode s e
newNode where
  newNode :: WidgetNode s e
newNode = Text
-> Bool
-> (Bool -> e)
-> [ToggleButtonCfg s e Bool]
-> WidgetNode s e
forall e s.
WidgetEvent e =>
Text
-> Bool
-> (Bool -> e)
-> [ToggleButtonCfg s e Bool]
-> WidgetNode s e
toggleButtonV_ Text
caption Bool
value Bool -> e
handler [ToggleButtonCfg s e Bool]
forall a. Default a => a
def

-- | Creates a toggleButton using the given value and 'onChange' event handler.
--   Accepts config.
toggleButtonV_
  :: WidgetEvent e
  => Text
  -> Bool
  -> (Bool -> e)
  -> [ToggleButtonCfg s e Bool]
  -> WidgetNode s e
toggleButtonV_ :: Text
-> Bool
-> (Bool -> e)
-> [ToggleButtonCfg s e Bool]
-> WidgetNode s e
toggleButtonV_ Text
caption Bool
value Bool -> e
handler [ToggleButtonCfg s e Bool]
configs = WidgetNode s e
newNode where
  widgetData :: WidgetData s Bool
widgetData = Bool -> WidgetData s Bool
forall s a. a -> WidgetData s a
WidgetValue Bool
value
  newConfigs :: [ToggleButtonCfg s e Bool]
newConfigs = (Bool -> e) -> ToggleButtonCfg s e Bool
forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange Bool -> e
handler ToggleButtonCfg s e Bool
-> [ToggleButtonCfg s e Bool] -> [ToggleButtonCfg s e Bool]
forall a. a -> [a] -> [a]
: [ToggleButtonCfg s e Bool]
configs
  newNode :: WidgetNode s e
newNode = Text
-> WidgetData s Bool
-> [ToggleButtonCfg s e Bool]
-> WidgetNode s e
forall s e.
Text
-> WidgetData s Bool
-> [ToggleButtonCfg s e Bool]
-> WidgetNode s e
toggleButtonD_ Text
caption WidgetData s Bool
forall s. WidgetData s Bool
widgetData [ToggleButtonCfg s e Bool]
newConfigs

-- | Creates a toggleButton providing a 'WidgetData' instance and config.
toggleButtonD_
  :: Text
  -> WidgetData s Bool
  -> [ToggleButtonCfg s e Bool]
  -> WidgetNode s e
toggleButtonD_ :: Text
-> WidgetData s Bool
-> [ToggleButtonCfg s e Bool]
-> WidgetNode s e
toggleButtonD_ Text
caption WidgetData s Bool
widgetData [ToggleButtonCfg s e Bool]
configs = WidgetNode s e
toggleButtonNode where
  config :: ToggleButtonCfg s e Bool
config = [ToggleButtonCfg s e Bool] -> ToggleButtonCfg s e Bool
forall a. Monoid a => [a] -> a
mconcat [ToggleButtonCfg s e Bool]
configs
  makeWithStyle :: WidgetData s Bool
-> Text
-> (Bool -> Bool)
-> (Bool -> Bool)
-> OptionButtonCfg s e Bool
-> Widget s e
makeWithStyle = Lens' ThemeState StyleState
-> Lens' ThemeState StyleState
-> WidgetData s Bool
-> Text
-> (Bool -> Bool)
-> (Bool -> Bool)
-> OptionButtonCfg s e Bool
-> Widget s e
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. HasToggleBtnOnStyle s a => Lens' s a
Lens' ThemeState StyleState
L.toggleBtnOnStyle forall s a. HasToggleBtnOffStyle s a => Lens' s a
Lens' ThemeState StyleState
L.toggleBtnOffStyle
  widget :: Widget s e
widget = WidgetData s Bool
-> Text
-> (Bool -> Bool)
-> (Bool -> Bool)
-> ToggleButtonCfg s e Bool
-> Widget s e
forall s e.
WidgetData s Bool
-> Text
-> (Bool -> Bool)
-> (Bool -> Bool)
-> OptionButtonCfg s e Bool
-> Widget s e
makeWithStyle WidgetData s Bool
widgetData Text
caption Bool -> Bool
forall a. a -> a
id Bool -> Bool
not ToggleButtonCfg s e Bool
config
  toggleButtonNode :: WidgetNode s e
toggleButtonNode = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"toggleButton" Widget s e
widget
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Bool -> Identity Bool)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Bool -> Identity Bool)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasFocusable s a => Lens' s a
L.focusable ((Bool -> Identity Bool)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Bool -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True