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

Radio widget, used for interacting with a fixed set of values with an associated
clickable label. Each instance of the radio will be associated with a single
value.
-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Strict #-}

module Monomer.Widgets.Singles.LabeledRadio (
  -- * Configuration
  LabeledRadioCfg,
  -- * Constructors
  labeledRadio,
  labeledRadio_,
  labeledRadioV,
  labeledRadioV_,
  labeledRadioD_
) where

import Control.Applicative ((<|>))
import Control.Lens (ALens', (&), (^.), (.~))
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.Label
import Monomer.Widgets.Singles.Radio

import qualified Monomer.Lens as L

{-|
Configuration options for labeledRadio:

- Text related

    - 'textLeft': places the label to the left of the radio.
    - 'textRight': places the label to the right of the radio.
    - 'textTop': places the label to the top of the radio.
    - 'textBottom': places the label to the bottom of the radio.
    - '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.

- Radio related

    - 'width': sets the max width/height of the radio.
    - '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 LabeledRadioCfg s e a = LabeledRadioCfg {
  LabeledRadioCfg s e a -> Maybe RectSide
_lchTextSide :: Maybe RectSide,
  LabeledRadioCfg s e a -> LabelCfg s e
_lchLabelCfg :: LabelCfg s e,
  LabeledRadioCfg s e a -> RadioCfg s e a
_lchRadioCfg :: RadioCfg s e a
}

instance Default (LabeledRadioCfg s e a) where
  def :: LabeledRadioCfg s e a
def = LabeledRadioCfg :: forall s e a.
Maybe RectSide
-> LabelCfg s e -> RadioCfg s e a -> LabeledRadioCfg s e a
LabeledRadioCfg {
    _lchTextSide :: Maybe RectSide
_lchTextSide = Maybe RectSide
forall a. Maybe a
Nothing,
    _lchLabelCfg :: LabelCfg s e
_lchLabelCfg = LabelCfg s e
forall a. Default a => a
def,
    _lchRadioCfg :: RadioCfg s e a
_lchRadioCfg = RadioCfg s e a
forall a. Default a => a
def
  }

instance Semigroup (LabeledRadioCfg s e a) where
  <> :: LabeledRadioCfg s e a
-> LabeledRadioCfg s e a -> LabeledRadioCfg s e a
(<>) LabeledRadioCfg s e a
t1 LabeledRadioCfg s e a
t2 = LabeledRadioCfg :: forall s e a.
Maybe RectSide
-> LabelCfg s e -> RadioCfg s e a -> LabeledRadioCfg s e a
LabeledRadioCfg {
    _lchTextSide :: Maybe RectSide
_lchTextSide = LabeledRadioCfg s e a -> Maybe RectSide
forall s e a. LabeledRadioCfg s e a -> Maybe RectSide
_lchTextSide LabeledRadioCfg s e a
t2 Maybe RectSide -> Maybe RectSide -> Maybe RectSide
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LabeledRadioCfg s e a -> Maybe RectSide
forall s e a. LabeledRadioCfg s e a -> Maybe RectSide
_lchTextSide LabeledRadioCfg s e a
t1,
    _lchLabelCfg :: LabelCfg s e
_lchLabelCfg = LabeledRadioCfg s e a -> LabelCfg s e
forall s e a. LabeledRadioCfg s e a -> LabelCfg s e
_lchLabelCfg LabeledRadioCfg s e a
t1 LabelCfg s e -> LabelCfg s e -> LabelCfg s e
forall a. Semigroup a => a -> a -> a
<> LabeledRadioCfg s e a -> LabelCfg s e
forall s e a. LabeledRadioCfg s e a -> LabelCfg s e
_lchLabelCfg LabeledRadioCfg s e a
t2,
    _lchRadioCfg :: RadioCfg s e a
_lchRadioCfg = LabeledRadioCfg s e a -> RadioCfg s e a
forall s e a. LabeledRadioCfg s e a -> RadioCfg s e a
_lchRadioCfg LabeledRadioCfg s e a
t1 RadioCfg s e a -> RadioCfg s e a -> RadioCfg s e a
forall a. Semigroup a => a -> a -> a
<> LabeledRadioCfg s e a -> RadioCfg s e a
forall s e a. LabeledRadioCfg s e a -> RadioCfg s e a
_lchRadioCfg LabeledRadioCfg s e a
t2
  }

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

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

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

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

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

instance CmbTrimSpaces (LabeledRadioCfg s e a) where
  trimSpaces_ :: Bool -> LabeledRadioCfg s e a
trimSpaces_ Bool
trim = LabeledRadioCfg s e a
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 (LabeledRadioCfg s e a) where
  ellipsis_ :: Bool -> LabeledRadioCfg s e a
ellipsis_ Bool
ellipsis = LabeledRadioCfg s e a
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 (LabeledRadioCfg s e a) where
  multiline_ :: Bool -> LabeledRadioCfg s e a
multiline_ Bool
multi = LabeledRadioCfg s e a
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 (LabeledRadioCfg s e a) where
  maxLines :: Int -> LabeledRadioCfg s e a
maxLines Int
count = LabeledRadioCfg s e a
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 (LabeledRadioCfg s e a) where
  resizeFactor :: Double -> LabeledRadioCfg s e a
resizeFactor Double
s = LabeledRadioCfg s e a
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 (LabeledRadioCfg s e a) where
  resizeFactorW :: Double -> LabeledRadioCfg s e a
resizeFactorW Double
w = LabeledRadioCfg s e a
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 -> LabeledRadioCfg s e a
resizeFactorH Double
h = LabeledRadioCfg s e a
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 CmbWidth (LabeledRadioCfg s e a) where
  width :: Double -> LabeledRadioCfg s e a
width Double
w = LabeledRadioCfg s e Any
forall a. Default a => a
def {
    _lchRadioCfg :: RadioCfg s e a
_lchRadioCfg = Double -> RadioCfg s e a
forall t. CmbWidth t => Double -> t
width Double
w
  }

instance WidgetEvent e => CmbOnFocus (LabeledRadioCfg s e a) e Path where
  onFocus :: (Path -> e) -> LabeledRadioCfg s e a
onFocus Path -> e
fn = LabeledRadioCfg s e Any
forall a. Default a => a
def {
    _lchRadioCfg :: RadioCfg s e a
_lchRadioCfg = (Path -> e) -> RadioCfg s e a
forall t e a. CmbOnFocus t e a => (a -> e) -> t
onFocus Path -> e
fn
  }

instance CmbOnFocusReq (LabeledRadioCfg s e a) s e Path where
  onFocusReq :: (Path -> WidgetRequest s e) -> LabeledRadioCfg s e a
onFocusReq Path -> WidgetRequest s e
req = LabeledRadioCfg s e Any
forall a. Default a => a
def {
    _lchRadioCfg :: RadioCfg s e a
_lchRadioCfg = (Path -> WidgetRequest s e) -> RadioCfg s e a
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 (LabeledRadioCfg s e a) e Path where
  onBlur :: (Path -> e) -> LabeledRadioCfg s e a
onBlur Path -> e
fn = LabeledRadioCfg s e Any
forall a. Default a => a
def {
    _lchRadioCfg :: RadioCfg s e a
_lchRadioCfg = (Path -> e) -> RadioCfg s e a
forall t e a. CmbOnBlur t e a => (a -> e) -> t
onBlur Path -> e
fn
  }

instance CmbOnBlurReq (LabeledRadioCfg s e a) s e Path where
  onBlurReq :: (Path -> WidgetRequest s e) -> LabeledRadioCfg s e a
onBlurReq Path -> WidgetRequest s e
req = LabeledRadioCfg s e Any
forall a. Default a => a
def {
    _lchRadioCfg :: RadioCfg s e a
_lchRadioCfg = (Path -> WidgetRequest s e) -> RadioCfg s e a
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 (LabeledRadioCfg s e a) a e where
  onChange :: (a -> e) -> LabeledRadioCfg s e a
onChange a -> e
fn = LabeledRadioCfg s e Any
forall a. Default a => a
def {
    _lchRadioCfg :: RadioCfg s e a
_lchRadioCfg = (a -> e) -> RadioCfg s e a
forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange a -> e
fn
  }

instance CmbOnChangeReq (LabeledRadioCfg s e a) s e a where
  onChangeReq :: (a -> WidgetRequest s e) -> LabeledRadioCfg s e a
onChangeReq a -> WidgetRequest s e
req = LabeledRadioCfg s e Any
forall a. Default a => a
def {
    _lchRadioCfg :: RadioCfg s e a
_lchRadioCfg = (a -> WidgetRequest s e) -> RadioCfg s e a
forall t s e a.
CmbOnChangeReq t s e a =>
(a -> WidgetRequest s e) -> t
onChangeReq a -> WidgetRequest s e
req
  }

-- | Creates a labeled radio using the given lens.
labeledRadio
  :: (Eq a, WidgetEvent e)
  => Text
  -> a
  -> ALens' s a
  -> WidgetNode s e
labeledRadio :: Text -> a -> ALens' s a -> WidgetNode s e
labeledRadio Text
caption a
option ALens' s a
field = Text
-> a -> ALens' s a -> [LabeledRadioCfg s e a] -> WidgetNode s e
forall a e s.
(Eq a, WidgetEvent e) =>
Text
-> a -> ALens' s a -> [LabeledRadioCfg s e a] -> WidgetNode s e
labeledRadio_ Text
caption a
option ALens' s a
field [LabeledRadioCfg s e a]
forall a. Default a => a
def

-- | Creates a labeled radio using the given lens. Accepts config.
labeledRadio_
  :: (Eq a, WidgetEvent e)
  => Text
  -> a
  -> ALens' s a
  -> [LabeledRadioCfg s e a]
  -> WidgetNode s e
labeledRadio_ :: Text
-> a -> ALens' s a -> [LabeledRadioCfg s e a] -> WidgetNode s e
labeledRadio_ Text
caption a
option ALens' s a
field [LabeledRadioCfg s e a]
config = WidgetNode s e
newNode where
  newNode :: WidgetNode s e
newNode = Text
-> a -> WidgetData s a -> [LabeledRadioCfg s e a] -> WidgetNode s e
forall a e s.
(Eq a, WidgetEvent e) =>
Text
-> a -> WidgetData s a -> [LabeledRadioCfg s e a] -> WidgetNode s e
labeledRadioD_ Text
caption a
option (ALens' s a -> WidgetData s a
forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s a
field) [LabeledRadioCfg s e a]
config

-- | Creates a labeled radio using the given value and 'onChange' event handler.
labeledRadioV
  :: (Eq a, WidgetEvent e)
  => Text
  -> a
  -> a
  -> (a -> e)
  -> WidgetNode s e
labeledRadioV :: Text -> a -> a -> (a -> e) -> WidgetNode s e
labeledRadioV Text
caption a
option a
value a -> e
handler = WidgetNode s e
forall s. WidgetNode s e
newNode where
  newNode :: WidgetNode s e
newNode = Text
-> a -> a -> (a -> e) -> [LabeledRadioCfg s e a] -> WidgetNode s e
forall a e s.
(Eq a, WidgetEvent e) =>
Text
-> a -> a -> (a -> e) -> [LabeledRadioCfg s e a] -> WidgetNode s e
labeledRadioV_ Text
caption a
option a
value a -> e
handler [LabeledRadioCfg s e a]
forall a. Default a => a
def

{-|
Creates a labeled radio using the given value and 'onChange' event handler.
Accepts config.
-}
labeledRadioV_
  :: (Eq a, WidgetEvent e)
  => Text
  -> a
  -> a
  -> (a -> e)
  -> [LabeledRadioCfg s e a]
  -> WidgetNode s e
labeledRadioV_ :: Text
-> a -> a -> (a -> e) -> [LabeledRadioCfg s e a] -> WidgetNode s e
labeledRadioV_ Text
caption a
option a
value a -> e
handler [LabeledRadioCfg s e a]
config = WidgetNode s e
newNode where
  newConfig :: [LabeledRadioCfg s e a]
newConfig = (a -> e) -> LabeledRadioCfg s e a
forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange a -> e
handler LabeledRadioCfg s e a
-> [LabeledRadioCfg s e a] -> [LabeledRadioCfg s e a]
forall a. a -> [a] -> [a]
: [LabeledRadioCfg s e a]
config
  newNode :: WidgetNode s e
newNode = Text
-> a -> WidgetData s a -> [LabeledRadioCfg s e a] -> WidgetNode s e
forall a e s.
(Eq a, WidgetEvent e) =>
Text
-> a -> WidgetData s a -> [LabeledRadioCfg s e a] -> WidgetNode s e
labeledRadioD_ Text
caption a
option (a -> WidgetData s a
forall s a. a -> WidgetData s a
WidgetValue a
value) [LabeledRadioCfg s e a]
newConfig

-- | Creates a labeled radio providing a 'WidgetData' instance and config.
labeledRadioD_
  :: (Eq a, WidgetEvent e)
  => Text
  -> a
  -> WidgetData s a
  -> [LabeledRadioCfg s e a]
  -> WidgetNode s e
labeledRadioD_ :: Text
-> a -> WidgetData s a -> [LabeledRadioCfg s e a] -> WidgetNode s e
labeledRadioD_ Text
caption a
option WidgetData s a
widgetData [LabeledRadioCfg s e a]
configs = WidgetNode s e
newNode where
  config :: LabeledRadioCfg s e a
config = [LabeledRadioCfg s e a] -> LabeledRadioCfg s e a
forall a. Monoid a => [a] -> a
mconcat [LabeledRadioCfg s e a]
configs
  labelSide :: RectSide
labelSide = RectSide -> Maybe RectSide -> RectSide
forall a. a -> Maybe a -> a
fromMaybe RectSide
SideLeft (LabeledRadioCfg s e a -> Maybe RectSide
forall s e a. LabeledRadioCfg s e a -> Maybe RectSide
_lchTextSide LabeledRadioCfg s e a
config)
  labelCfg :: LabelCfg s e
labelCfg = LabeledRadioCfg s e a -> LabelCfg s e
forall s e a. LabeledRadioCfg s e a -> LabelCfg s e
_lchLabelCfg LabeledRadioCfg s e a
config
  widget :: WidgetNode s e
widget = a -> WidgetData s a -> [RadioCfg s e a] -> WidgetNode s e
forall a e s.
(Eq a, WidgetEvent e) =>
a -> WidgetData s a -> [RadioCfg s e a] -> WidgetNode s e
radioD_ a
option WidgetData s a
widgetData [LabeledRadioCfg s e a -> RadioCfg s e a
forall s e a. LabeledRadioCfg s e a -> RadioCfg s e a
_lchRadioCfg LabeledRadioCfg s e a
config]
  newNode :: WidgetNode s e
newNode = WidgetType
-> RectSide
-> Text
-> LabelCfg s e
-> WidgetNode s e
-> WidgetNode s e
forall e s.
WidgetEvent e =>
WidgetType
-> RectSide
-> Text
-> LabelCfg s e
-> WidgetNode s e
-> WidgetNode s e
labeledItem WidgetType
"labeledRadio" RectSide
labelSide Text
caption LabelCfg s e
labelCfg WidgetNode s e
widget