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

Labeled checkbox, used for interacting with boolean values. In contrast to
'checkbox', it includes a clickable label.

@
labeledCheckbox "Bool value" booleanLens
@

With text in a different location:

@
labeledCheckbox_ "Checkbox with text below" booleanLens [textBottom]
@
-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Strict #-}

module Monomer.Widgets.Singles.LabeledCheckbox (
  -- * Configuration
  LabeledCheckboxCfg,
  -- * Constructors
  labeledCheckbox,
  labeledCheckbox_,
  labeledCheckboxV,
  labeledCheckboxV_,
  labeledCheckboxD_
) where

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

import qualified Data.Sequence as Seq

import Monomer.Widgets.Containers.Base.LabeledItem
import Monomer.Widgets.Single
import Monomer.Widgets.Singles.Checkbox
import Monomer.Widgets.Singles.Label

import qualified Monomer.Lens as L

{-|
Configuration options for labeledCheckbox:

- General

    - 'childSpacing': the spacing between the checkbox and the text.

- Text related

    - 'textLeft': places the label to the left of the checkbox.
    - 'textRight': places the label to the right of the checkbox.
    - 'textTop': places the label to the top of the checkbox.
    - 'textBottom': places the label to the bottom of the checkbox.
    - '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 for more or less horizontal spaced assigned.
    - 'resizeFactorH': flexibility for more or less vertical spaced assigned.

- Checkbox related

    - 'checkboxMark': the type of checkbox mark.
    - 'width': sets the max width/height of the checkbox.
    - '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.
    - 'onChange': event to raise when the value changes/is clicked.
    - 'onChangeReq': 'WidgetRequest' to generate when the value changes/is clicked.
-}
data LabeledCheckboxCfg s e = LabeledCheckboxCfg {
  LabeledCheckboxCfg s e -> Maybe RectSide
_lchTextSide :: Maybe RectSide,
  LabeledCheckboxCfg s e -> Maybe Double
_lchChildSpacing :: Maybe Double,
  LabeledCheckboxCfg s e -> LabelCfg s e
_lchLabelCfg :: LabelCfg s e,
  LabeledCheckboxCfg s e -> CheckboxCfg s e
_lchCheckboxCfg :: CheckboxCfg s e
}

instance Default (LabeledCheckboxCfg s e) where
  def :: LabeledCheckboxCfg s e
def = LabeledCheckboxCfg :: forall s e.
Maybe RectSide
-> Maybe Double
-> LabelCfg s e
-> CheckboxCfg s e
-> LabeledCheckboxCfg s e
LabeledCheckboxCfg {
    _lchTextSide :: Maybe RectSide
_lchTextSide = Maybe RectSide
forall a. Maybe a
Nothing,
    _lchChildSpacing :: Maybe Double
_lchChildSpacing = Maybe Double
forall a. Maybe a
Nothing,
    _lchLabelCfg :: LabelCfg s e
_lchLabelCfg = LabelCfg s e
forall a. Default a => a
def,
    _lchCheckboxCfg :: CheckboxCfg s e
_lchCheckboxCfg = CheckboxCfg s e
forall a. Default a => a
def
  }

instance Semigroup (LabeledCheckboxCfg s e) where
  <> :: LabeledCheckboxCfg s e
-> LabeledCheckboxCfg s e -> LabeledCheckboxCfg s e
(<>) LabeledCheckboxCfg s e
t1 LabeledCheckboxCfg s e
t2 = LabeledCheckboxCfg :: forall s e.
Maybe RectSide
-> Maybe Double
-> LabelCfg s e
-> CheckboxCfg s e
-> LabeledCheckboxCfg s e
LabeledCheckboxCfg {
    _lchTextSide :: Maybe RectSide
_lchTextSide = LabeledCheckboxCfg s e -> Maybe RectSide
forall s e. LabeledCheckboxCfg s e -> Maybe RectSide
_lchTextSide LabeledCheckboxCfg s e
t2 Maybe RectSide -> Maybe RectSide -> Maybe RectSide
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LabeledCheckboxCfg s e -> Maybe RectSide
forall s e. LabeledCheckboxCfg s e -> Maybe RectSide
_lchTextSide LabeledCheckboxCfg s e
t1,
    _lchChildSpacing :: Maybe Double
_lchChildSpacing = LabeledCheckboxCfg s e -> Maybe Double
forall s e. LabeledCheckboxCfg s e -> Maybe Double
_lchChildSpacing LabeledCheckboxCfg s e
t2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LabeledCheckboxCfg s e -> Maybe Double
forall s e. LabeledCheckboxCfg s e -> Maybe Double
_lchChildSpacing LabeledCheckboxCfg s e
t1,
    _lchLabelCfg :: LabelCfg s e
_lchLabelCfg = LabeledCheckboxCfg s e -> LabelCfg s e
forall s e. LabeledCheckboxCfg s e -> LabelCfg s e
_lchLabelCfg LabeledCheckboxCfg s e
t1 LabelCfg s e -> LabelCfg s e -> LabelCfg s e
forall a. Semigroup a => a -> a -> a
<> LabeledCheckboxCfg s e -> LabelCfg s e
forall s e. LabeledCheckboxCfg s e -> LabelCfg s e
_lchLabelCfg LabeledCheckboxCfg s e
t2,
    _lchCheckboxCfg :: CheckboxCfg s e
_lchCheckboxCfg = LabeledCheckboxCfg s e -> CheckboxCfg s e
forall s e. LabeledCheckboxCfg s e -> CheckboxCfg s e
_lchCheckboxCfg LabeledCheckboxCfg s e
t1 CheckboxCfg s e -> CheckboxCfg s e -> CheckboxCfg s e
forall a. Semigroup a => a -> a -> a
<> LabeledCheckboxCfg s e -> CheckboxCfg s e
forall s e. LabeledCheckboxCfg s e -> CheckboxCfg s e
_lchCheckboxCfg LabeledCheckboxCfg s e
t2
  }

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

instance CmbChildSpacing (LabeledCheckboxCfg s e) where
  childSpacing_ :: Double -> LabeledCheckboxCfg s e
childSpacing_ Double
spacing = LabeledCheckboxCfg s e
forall a. Default a => a
def {
    _lchChildSpacing :: Maybe Double
_lchChildSpacing = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
spacing
  }

instance CmbTextLeft (LabeledCheckboxCfg s e) where
  textLeft_ :: Bool -> LabeledCheckboxCfg s e
textLeft_ Bool
False = LabeledCheckboxCfg s e
forall a. Default a => a
def
  textLeft_ Bool
True = LabeledCheckboxCfg s e
forall a. Default a => a
def {
    _lchTextSide :: Maybe RectSide
_lchTextSide = RectSide -> Maybe RectSide
forall a. a -> Maybe a
Just RectSide
SideLeft
  }

instance CmbTextRight (LabeledCheckboxCfg s e) where
  textRight_ :: Bool -> LabeledCheckboxCfg s e
textRight_ Bool
False = LabeledCheckboxCfg s e
forall a. Default a => a
def
  textRight_ Bool
True = LabeledCheckboxCfg s e
forall a. Default a => a
def {
    _lchTextSide :: Maybe RectSide
_lchTextSide = RectSide -> Maybe RectSide
forall a. a -> Maybe a
Just RectSide
SideRight
  }

instance CmbTextTop (LabeledCheckboxCfg s e) where
  textTop_ :: Bool -> LabeledCheckboxCfg s e
textTop_ Bool
False = LabeledCheckboxCfg s e
forall a. Default a => a
def
  textTop_ Bool
True = LabeledCheckboxCfg s e
forall a. Default a => a
def {
    _lchTextSide :: Maybe RectSide
_lchTextSide = RectSide -> Maybe RectSide
forall a. a -> Maybe a
Just RectSide
SideTop
  }

instance CmbTextBottom (LabeledCheckboxCfg s e) where
  textBottom_ :: Bool -> LabeledCheckboxCfg s e
textBottom_ Bool
False = LabeledCheckboxCfg s e
forall a. Default a => a
def
  textBottom_ Bool
True = LabeledCheckboxCfg s e
forall a. Default a => a
def {
    _lchTextSide :: Maybe RectSide
_lchTextSide = RectSide -> Maybe RectSide
forall a. a -> Maybe a
Just RectSide
SideBottom
  }

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

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

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

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

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

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

instance CmbCheckboxMark (LabeledCheckboxCfg s e) where
  checkboxMark :: CheckboxMark -> LabeledCheckboxCfg s e
checkboxMark CheckboxMark
mark = LabeledCheckboxCfg s e
forall a. Default a => a
def {
    _lchCheckboxCfg :: CheckboxCfg s e
_lchCheckboxCfg = CheckboxMark -> CheckboxCfg s e
forall t. CmbCheckboxMark t => CheckboxMark -> t
checkboxMark CheckboxMark
mark
  }
  checkboxSquare :: LabeledCheckboxCfg s e
checkboxSquare = CheckboxMark -> LabeledCheckboxCfg s e
forall t. CmbCheckboxMark t => CheckboxMark -> t
checkboxMark CheckboxMark
CheckboxSquare
  checkboxTimes :: LabeledCheckboxCfg s e
checkboxTimes = CheckboxMark -> LabeledCheckboxCfg s e
forall t. CmbCheckboxMark t => CheckboxMark -> t
checkboxMark CheckboxMark
CheckboxTimes

instance CmbWidth (LabeledCheckboxCfg s e) where
  width :: Double -> LabeledCheckboxCfg s e
width Double
w = LabeledCheckboxCfg s e
forall a. Default a => a
def {
    _lchCheckboxCfg :: CheckboxCfg s e
_lchCheckboxCfg = Double -> CheckboxCfg s e
forall t. CmbWidth t => Double -> t
width Double
w
  }

instance WidgetEvent e => CmbOnFocus (LabeledCheckboxCfg s e) e Path where
  onFocus :: (Path -> e) -> LabeledCheckboxCfg s e
onFocus Path -> e
fn = LabeledCheckboxCfg s e
forall a. Default a => a
def {
    _lchCheckboxCfg :: CheckboxCfg s e
_lchCheckboxCfg = (Path -> e) -> CheckboxCfg s e
forall t e a. CmbOnFocus t e a => (a -> e) -> t
onFocus Path -> e
fn
  }

instance CmbOnFocusReq (LabeledCheckboxCfg s e) s e Path where
  onFocusReq :: (Path -> WidgetRequest s e) -> LabeledCheckboxCfg s e
onFocusReq Path -> WidgetRequest s e
req = LabeledCheckboxCfg s e
forall a. Default a => a
def {
    _lchCheckboxCfg :: CheckboxCfg s e
_lchCheckboxCfg = (Path -> WidgetRequest s e) -> CheckboxCfg s e
forall t s e a.
CmbOnFocusReq t s e a =>
(a -> WidgetRequest s e) -> t
onFocusReq Path -> WidgetRequest s e
req
  }

instance WidgetEvent e => CmbOnBlur (LabeledCheckboxCfg s e) e Path where
  onBlur :: (Path -> e) -> LabeledCheckboxCfg s e
onBlur Path -> e
fn = LabeledCheckboxCfg s e
forall a. Default a => a
def {
    _lchCheckboxCfg :: CheckboxCfg s e
_lchCheckboxCfg = (Path -> e) -> CheckboxCfg s e
forall t e a. CmbOnBlur t e a => (a -> e) -> t
onBlur Path -> e
fn
  }

instance CmbOnBlurReq (LabeledCheckboxCfg s e) s e Path where
  onBlurReq :: (Path -> WidgetRequest s e) -> LabeledCheckboxCfg s e
onBlurReq Path -> WidgetRequest s e
req = LabeledCheckboxCfg s e
forall a. Default a => a
def {
    _lchCheckboxCfg :: CheckboxCfg s e
_lchCheckboxCfg = (Path -> WidgetRequest s e) -> CheckboxCfg s e
forall t s e a.
CmbOnBlurReq t s e a =>
(a -> WidgetRequest s e) -> t
onBlurReq Path -> WidgetRequest s e
req
  }

instance WidgetEvent e => CmbOnChange (LabeledCheckboxCfg s e) Bool e where
  onChange :: (Bool -> e) -> LabeledCheckboxCfg s e
onChange Bool -> e
fn = LabeledCheckboxCfg s e
forall a. Default a => a
def {
    _lchCheckboxCfg :: CheckboxCfg s e
_lchCheckboxCfg = (Bool -> e) -> CheckboxCfg s e
forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange Bool -> e
fn
  }

instance CmbOnChangeReq (LabeledCheckboxCfg s e) s e Bool where
  onChangeReq :: (Bool -> WidgetRequest s e) -> LabeledCheckboxCfg s e
onChangeReq Bool -> WidgetRequest s e
req = LabeledCheckboxCfg s e
forall a. Default a => a
def {
    _lchCheckboxCfg :: CheckboxCfg s e
_lchCheckboxCfg = (Bool -> WidgetRequest s e) -> CheckboxCfg s e
forall t s e a.
CmbOnChangeReq t s e a =>
(a -> WidgetRequest s e) -> t
onChangeReq Bool -> WidgetRequest s e
req
  }

-- | Creates a labeled checkbox using the given lens.
labeledCheckbox :: WidgetEvent e => Text -> ALens' s Bool -> WidgetNode s e
labeledCheckbox :: Text -> ALens' s Bool -> WidgetNode s e
labeledCheckbox Text
caption ALens' s Bool
field = Text -> ALens' s Bool -> [LabeledCheckboxCfg s e] -> WidgetNode s e
forall e s.
WidgetEvent e =>
Text -> ALens' s Bool -> [LabeledCheckboxCfg s e] -> WidgetNode s e
labeledCheckbox_ Text
caption ALens' s Bool
field [LabeledCheckboxCfg s e]
forall a. Default a => a
def

-- | Creates a labeled checkbox using the given lens. Accepts config.
labeledCheckbox_
  :: WidgetEvent e
  => Text
  -> ALens' s Bool
  -> [LabeledCheckboxCfg s e]
  -> WidgetNode s e
labeledCheckbox_ :: Text -> ALens' s Bool -> [LabeledCheckboxCfg s e] -> WidgetNode s e
labeledCheckbox_ Text
caption ALens' s Bool
field [LabeledCheckboxCfg s e]
config = WidgetNode s e
newNode where
  newNode :: WidgetNode s e
newNode = Text
-> WidgetData s Bool -> [LabeledCheckboxCfg s e] -> WidgetNode s e
forall e s.
WidgetEvent e =>
Text
-> WidgetData s Bool -> [LabeledCheckboxCfg s e] -> WidgetNode s e
labeledCheckboxD_ Text
caption (ALens' s Bool -> WidgetData s Bool
forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s Bool
field) [LabeledCheckboxCfg s e]
config

-- | Creates a labeled checkbox using the given value and 'onChange' event
--   handler.
labeledCheckboxV
  :: WidgetEvent e
  => Text
  -> Bool
  -> (Bool -> e)
  -> WidgetNode s e
labeledCheckboxV :: Text -> Bool -> (Bool -> e) -> WidgetNode s e
labeledCheckboxV 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)
-> [LabeledCheckboxCfg s e]
-> WidgetNode s e
forall e s.
WidgetEvent e =>
Text
-> Bool
-> (Bool -> e)
-> [LabeledCheckboxCfg s e]
-> WidgetNode s e
labeledCheckboxV_ Text
caption Bool
value Bool -> e
handler [LabeledCheckboxCfg s e]
forall a. Default a => a
def

{-|
Creates a labeled checkbox using the given value and 'onChange' event handler.
Accepts config.
-}
labeledCheckboxV_
  :: WidgetEvent e
  => Text
  -> Bool
  -> (Bool -> e)
  -> [LabeledCheckboxCfg s e]
  -> WidgetNode s e
labeledCheckboxV_ :: Text
-> Bool
-> (Bool -> e)
-> [LabeledCheckboxCfg s e]
-> WidgetNode s e
labeledCheckboxV_ Text
caption Bool
value Bool -> e
handler [LabeledCheckboxCfg s e]
config = WidgetNode s e
newNode where
  newConfig :: [LabeledCheckboxCfg s e]
newConfig = (Bool -> e) -> LabeledCheckboxCfg s e
forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange Bool -> e
handler LabeledCheckboxCfg s e
-> [LabeledCheckboxCfg s e] -> [LabeledCheckboxCfg s e]
forall a. a -> [a] -> [a]
: [LabeledCheckboxCfg s e]
config
  newNode :: WidgetNode s e
newNode = Text
-> WidgetData s Bool -> [LabeledCheckboxCfg s e] -> WidgetNode s e
forall e s.
WidgetEvent e =>
Text
-> WidgetData s Bool -> [LabeledCheckboxCfg s e] -> WidgetNode s e
labeledCheckboxD_ Text
caption (Bool -> WidgetData s Bool
forall s a. a -> WidgetData s a
WidgetValue Bool
value) [LabeledCheckboxCfg s e]
newConfig

-- | Creates a labeled checkbox providing a 'WidgetData' instance and config.
labeledCheckboxD_
  :: WidgetEvent e
  => Text
  -> WidgetData s Bool
  -> [LabeledCheckboxCfg s e]
  -> WidgetNode s e
labeledCheckboxD_ :: Text
-> WidgetData s Bool -> [LabeledCheckboxCfg s e] -> WidgetNode s e
labeledCheckboxD_ Text
caption WidgetData s Bool
widgetData [LabeledCheckboxCfg s e]
configs = WidgetNode s e
newNode where
  config :: LabeledCheckboxCfg s e
config = [LabeledCheckboxCfg s e] -> LabeledCheckboxCfg s e
forall a. Monoid a => [a] -> a
mconcat [LabeledCheckboxCfg s e]
configs
  labelSide :: RectSide
labelSide = RectSide -> Maybe RectSide -> RectSide
forall a. a -> Maybe a -> a
fromMaybe RectSide
SideLeft (LabeledCheckboxCfg s e -> Maybe RectSide
forall s e. LabeledCheckboxCfg s e -> Maybe RectSide
_lchTextSide LabeledCheckboxCfg s e
config)
  childSpacing :: Maybe Double
childSpacing = LabeledCheckboxCfg s e -> Maybe Double
forall s e. LabeledCheckboxCfg s e -> Maybe Double
_lchChildSpacing LabeledCheckboxCfg s e
config
  labelCfg :: LabelCfg s e
labelCfg = LabeledCheckboxCfg s e -> LabelCfg s e
forall s e. LabeledCheckboxCfg s e -> LabelCfg s e
_lchLabelCfg LabeledCheckboxCfg s e
config
  widget :: WidgetNode s e
widget = WidgetData s Bool -> [CheckboxCfg s e] -> WidgetNode s e
forall e s.
WidgetEvent e =>
WidgetData s Bool -> [CheckboxCfg s e] -> WidgetNode s e
checkboxD_ WidgetData s Bool
widgetData [LabeledCheckboxCfg s e -> CheckboxCfg s e
forall s e. LabeledCheckboxCfg s e -> CheckboxCfg s e
_lchCheckboxCfg LabeledCheckboxCfg s e
config]
  newNode :: WidgetNode s e
newNode = WidgetType
-> RectSide
-> Maybe Double
-> Text
-> LabelCfg s e
-> WidgetNode s e
-> WidgetNode s e
forall e s.
WidgetEvent e =>
WidgetType
-> RectSide
-> Maybe Double
-> Text
-> LabelCfg s e
-> WidgetNode s e
-> WidgetNode s e
labeledItem WidgetType
"labeledCheckbox" RectSide
labelSide Maybe Double
childSpacing Text
caption LabelCfg s e
labelCfg WidgetNode s e
widget