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

Color popup, displayed inside its parent container as a colored square. When
clicked, it opens a color picker overlay.

Shows sliders for the color components.

@
colorPopup colorLens
@

Optionally shows a slider for the alpha channel.

@
colorPopup_ colorLens [showAlpha]
@
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TemplateHaskell #-}

module Monomer.Widgets.Singles.ColorPopup (
  -- * Constructors
  colorPopup,
  colorPopup_,
  colorPopupV,
  colorPopupV_
) where

import Control.Lens ((&), (^.), (.~), (?~), ALens', abbreviatedFields, makeLensesWith, non)
import Data.Default

import Monomer.Core.Combinators
import Monomer.Graphics.Types

import Monomer.Widgets.Composite
import Monomer.Widgets.Containers.BoxShadow
import Monomer.Widgets.Containers.Popup
import Monomer.Widgets.Singles.ColorPicker
import Monomer.Widgets.Singles.ToggleButton

import qualified Monomer.Lens as L

type ColorPopupEnv = WidgetEnv ColorPopupModel ColorPopupEvt
type ColorPopupNode = WidgetNode ColorPopupModel ColorPopupEvt

{-|
Configuration options for colorPopup:

- 'showAlpha': whether to allow modifying the alpha channel or not.
- '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 any of the values changes.
- 'onChangeReq': 'WidgetRequest' to generate when any of the values changes.
-}
data ColorPopupCfg s e = ColorPopupCfg {
  forall s e.
ColorPopupCfg s e -> ColorPickerCfg ColorPopupModel ColorPopupEvt
_cpcColorPickerCfg :: ColorPickerCfg ColorPopupModel ColorPopupEvt,
  forall s e. ColorPopupCfg s e -> [Path -> WidgetRequest s e]
_cpcOnFocusReq :: [Path -> WidgetRequest s e],
  forall s e. ColorPopupCfg s e -> [Path -> WidgetRequest s e]
_cpcOnBlurReq :: [Path -> WidgetRequest s e],
  forall s e. ColorPopupCfg s e -> [Color -> WidgetRequest s e]
_cpcOnChangeReq :: [Color -> WidgetRequest s e]
}

instance Default (ColorPopupCfg s e) where
  def :: ColorPopupCfg s e
def = ColorPopupCfg {
    _cpcColorPickerCfg :: ColorPickerCfg ColorPopupModel ColorPopupEvt
_cpcColorPickerCfg = ColorPickerCfg ColorPopupModel ColorPopupEvt
forall a. Default a => a
def,
    _cpcOnFocusReq :: [Path -> WidgetRequest s e]
_cpcOnFocusReq = [],
    _cpcOnBlurReq :: [Path -> WidgetRequest s e]
_cpcOnBlurReq = [],
    _cpcOnChangeReq :: [Color -> WidgetRequest s e]
_cpcOnChangeReq = []
  }

instance Semigroup (ColorPopupCfg s e) where
  <> :: ColorPopupCfg s e -> ColorPopupCfg s e -> ColorPopupCfg s e
(<>) ColorPopupCfg s e
a1 ColorPopupCfg s e
a2 = ColorPopupCfg Any Any
forall a. Default a => a
def {
    _cpcColorPickerCfg = _cpcColorPickerCfg a1 <> _cpcColorPickerCfg a2,
    _cpcOnFocusReq = _cpcOnFocusReq a1 <> _cpcOnFocusReq a2,
    _cpcOnBlurReq = _cpcOnBlurReq a1 <> _cpcOnBlurReq a2,
    _cpcOnChangeReq = _cpcOnChangeReq a1 <> _cpcOnChangeReq a2
  }

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

instance CmbShowAlpha (ColorPopupCfg s e) where
  showAlpha_ :: Bool -> ColorPopupCfg s e
showAlpha_ Bool
show = ColorPopupCfg s e
forall a. Default a => a
def {
    _cpcColorPickerCfg = showAlpha_ show
  }

instance WidgetEvent e => CmbOnFocus (ColorPopupCfg s e) e Path where
  onFocus :: (Path -> e) -> ColorPopupCfg s e
onFocus Path -> e
fn = ColorPopupCfg s e
forall a. Default a => a
def {
    _cpcOnFocusReq = [RaiseEvent . fn]
  }

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

instance WidgetEvent e => CmbOnBlur (ColorPopupCfg s e) e Path where
  onBlur :: (Path -> e) -> ColorPopupCfg s e
onBlur Path -> e
fn = ColorPopupCfg s e
forall a. Default a => a
def {
    _cpcOnBlurReq = [RaiseEvent . fn]
  }

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

instance WidgetEvent e => CmbOnChange (ColorPopupCfg s e) Color e where
  onChange :: (Color -> e) -> ColorPopupCfg s e
onChange Color -> e
fn = ColorPopupCfg s e
forall a. Default a => a
def {
    _cpcOnChangeReq = [RaiseEvent . fn]
  }

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

data ColorPopupModel = ColorPopupModel {
  ColorPopupModel -> Bool
_cpmPopupShowColor :: Bool,
  ColorPopupModel -> Color
_cpmPopupColor :: Color
} deriving (ColorPopupModel -> ColorPopupModel -> Bool
(ColorPopupModel -> ColorPopupModel -> Bool)
-> (ColorPopupModel -> ColorPopupModel -> Bool)
-> Eq ColorPopupModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColorPopupModel -> ColorPopupModel -> Bool
== :: ColorPopupModel -> ColorPopupModel -> Bool
$c/= :: ColorPopupModel -> ColorPopupModel -> Bool
/= :: ColorPopupModel -> ColorPopupModel -> Bool
Eq, Int -> ColorPopupModel -> ShowS
[ColorPopupModel] -> ShowS
ColorPopupModel -> String
(Int -> ColorPopupModel -> ShowS)
-> (ColorPopupModel -> String)
-> ([ColorPopupModel] -> ShowS)
-> Show ColorPopupModel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColorPopupModel -> ShowS
showsPrec :: Int -> ColorPopupModel -> ShowS
$cshow :: ColorPopupModel -> String
show :: ColorPopupModel -> String
$cshowList :: [ColorPopupModel] -> ShowS
showList :: [ColorPopupModel] -> ShowS
Show)

data ColorPopupEvt
  = ColorChanged Color
  | PopupFocus Path
  | PopupBlur Path

instance Default ColorPopupModel where
  def :: ColorPopupModel
def = ColorPopupModel {
    _cpmPopupShowColor :: Bool
_cpmPopupShowColor = Bool
False,
    _cpmPopupColor :: Color
_cpmPopupColor = Color
forall a. Default a => a
def
  }

makeLensesWith abbreviatedFields 'ColorPopupModel

-- | Creates a colorPopup using the given lens.
colorPopup
  :: (WidgetModel s, WidgetEvent e)
  => ALens' s Color  -- ^ The lens into the model.
  -> WidgetNode s e  -- ^ The created color popup.
colorPopup :: forall s e.
(WidgetModel s, WidgetEvent e) =>
ALens' s Color -> WidgetNode s e
colorPopup ALens' s Color
field = ALens' s Color -> [ColorPopupCfg s e] -> WidgetNode s e
forall s e.
(WidgetModel s, WidgetEvent e) =>
ALens' s Color -> [ColorPopupCfg s e] -> WidgetNode s e
colorPopup_ ALens' s Color
field [ColorPopupCfg s e]
forall a. Default a => a
def

-- | Creates a colorPopup using the given lens. Accepts config.
colorPopup_
  :: (WidgetModel s, WidgetEvent e)
  => ALens' s Color       -- ^ The lens into the model.
  -> [ColorPopupCfg s e]  -- ^ The config options.
  -> WidgetNode s e       -- ^ The created color popup.
colorPopup_ :: forall s e.
(WidgetModel s, WidgetEvent e) =>
ALens' s Color -> [ColorPopupCfg s e] -> WidgetNode s e
colorPopup_ ALens' s Color
field [ColorPopupCfg s e]
configs = WidgetData s Color -> [ColorPopupCfg s e] -> WidgetNode s e
forall s e.
(WidgetModel s, WidgetEvent e) =>
WidgetData s Color -> [ColorPopupCfg s e] -> WidgetNode s e
colorPopupD_ (ALens' s Color -> WidgetData s Color
forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s Color
field) [ColorPopupCfg s e]
configs

-- | Creates a colorPopup using the given value and 'onChange' event handler.
colorPopupV
  :: (WidgetModel s, WidgetEvent e)
  => Color           -- ^ The current value.
  -> (Color -> e)    -- ^ The event to raise on change.
  -> WidgetNode s e  -- ^ The created color popup.
colorPopupV :: forall s e.
(WidgetModel s, WidgetEvent e) =>
Color -> (Color -> e) -> WidgetNode s e
colorPopupV Color
value Color -> e
handler = Color -> (Color -> e) -> [ColorPopupCfg s e] -> WidgetNode s e
forall s e.
(WidgetModel s, WidgetEvent e) =>
Color -> (Color -> e) -> [ColorPopupCfg s e] -> WidgetNode s e
colorPopupV_ Color
value Color -> e
handler [ColorPopupCfg s e]
forall a. Default a => a
def

-- | Creates a colorPopup using the given value and 'onChange' event handler.
--   Accepts config.
colorPopupV_
  :: (WidgetModel s, WidgetEvent e)
  => Color                -- ^ The current value.
  -> (Color -> e)         -- ^ The event to raise on change.
  -> [ColorPopupCfg s e]  -- ^ The config options.
  -> WidgetNode s e       -- ^ The created color popup.
colorPopupV_ :: forall s e.
(WidgetModel s, WidgetEvent e) =>
Color -> (Color -> e) -> [ColorPopupCfg s e] -> WidgetNode s e
colorPopupV_ Color
value Color -> e
handler [ColorPopupCfg s e]
configs = WidgetNode s e
newNode where
  newConfigs :: [ColorPopupCfg s e]
newConfigs = (Color -> e) -> ColorPopupCfg s e
forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange Color -> e
handler ColorPopupCfg s e -> [ColorPopupCfg s e] -> [ColorPopupCfg s e]
forall a. a -> [a] -> [a]
: [ColorPopupCfg s e]
configs
  newNode :: WidgetNode s e
newNode = WidgetData s Color -> [ColorPopupCfg s e] -> WidgetNode s e
forall s e.
(WidgetModel s, WidgetEvent e) =>
WidgetData s Color -> [ColorPopupCfg s e] -> WidgetNode s e
colorPopupD_ (Color -> WidgetData s Color
forall s a. a -> WidgetData s a
WidgetValue Color
value) [ColorPopupCfg s e]
newConfigs

-- | Creates a colorPopup providing a 'WidgetData' instance and config.
colorPopupD_
  :: (WidgetModel s, WidgetEvent e)
  => WidgetData s Color   -- ^ The 'WidgetData' to retrieve the value from.
  -> [ColorPopupCfg s e]  -- ^ The config options.
  -> WidgetNode s e       -- ^ The created color popup.
colorPopupD_ :: forall s e.
(WidgetModel s, WidgetEvent e) =>
WidgetData s Color -> [ColorPopupCfg s e] -> WidgetNode s e
colorPopupD_ WidgetData s Color
wdata [ColorPopupCfg s e]
configs = WidgetNode s e
newNode where
  config :: ColorPopupCfg s e
config = [ColorPopupCfg s e] -> ColorPopupCfg s e
forall a. Monoid a => [a] -> a
mconcat [ColorPopupCfg s e]
configs
  model :: WidgetData s ColorPopupModel
model = ColorPopupModel -> WidgetData s ColorPopupModel
forall s a. a -> WidgetData s a
WidgetValue ColorPopupModel
forall a. Default a => a
def
  uiBuilder :: ColorPopupEnv -> ColorPopupModel -> ColorPopupNode
uiBuilder = ColorPopupCfg s e
-> ColorPopupEnv -> ColorPopupModel -> ColorPopupNode
forall sp ep.
WidgetModel sp =>
ColorPopupCfg sp ep
-> ColorPopupEnv -> ColorPopupModel -> ColorPopupNode
buildUI ColorPopupCfg s e
config
  eventHandler :: ColorPopupEnv
-> ColorPopupNode
-> ColorPopupModel
-> ColorPopupEvt
-> [EventResponse ColorPopupModel ColorPopupEvt s e]
eventHandler = WidgetData s Color
-> ColorPopupCfg s e
-> ColorPopupEnv
-> ColorPopupNode
-> ColorPopupModel
-> ColorPopupEvt
-> [EventResponse ColorPopupModel ColorPopupEvt s e]
forall sp ep.
WidgetModel sp =>
WidgetData sp Color
-> ColorPopupCfg sp ep
-> ColorPopupEnv
-> ColorPopupNode
-> ColorPopupModel
-> ColorPopupEvt
-> [EventResponse ColorPopupModel ColorPopupEvt sp ep]
handleEvent WidgetData s Color
wdata ColorPopupCfg s e
config
  mergeModel :: p -> s -> b -> p -> b
mergeModel p
wenv s
parentModel b
oldModel p
newModel = b
oldModel
    b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (Color -> Identity Color) -> b -> Identity b
forall s a. HasPopupColor s a => Lens' s a
Lens' b Color
popupColor ((Color -> Identity Color) -> b -> Identity b) -> Color -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ s -> WidgetData s Color -> Color
forall s a. s -> WidgetData s a -> a
widgetDataGet s
parentModel WidgetData s Color
wdata
  compCfg :: [CompositeCfg ColorPopupModel e s ep]
compCfg = [MergeModelHandler ColorPopupModel e s
-> CompositeCfg ColorPopupModel e s ep
forall s e sp ep.
MergeModelHandler s e sp -> CompositeCfg s e sp ep
compositeMergeModel MergeModelHandler ColorPopupModel e s
forall {b} {p} {p}. HasPopupColor b Color => p -> s -> b -> p -> b
mergeModel]
  newNode :: WidgetNode s e
newNode = WidgetType
-> WidgetData s ColorPopupModel
-> (ColorPopupEnv -> ColorPopupModel -> ColorPopupNode)
-> (ColorPopupEnv
    -> ColorPopupNode
    -> ColorPopupModel
    -> ColorPopupEvt
    -> [EventResponse ColorPopupModel ColorPopupEvt s e])
-> [CompositeCfg ColorPopupModel ColorPopupEvt s e]
-> WidgetNode s e
forall s e ep sp.
(CompositeModel s, CompositeEvent e, CompositeEvent ep,
 CompParentModel sp) =>
WidgetType
-> WidgetData sp s
-> UIBuilder s e
-> EventHandler s e sp ep
-> [CompositeCfg s e sp ep]
-> WidgetNode sp ep
compositeD_ WidgetType
"colorPopup" WidgetData s ColorPopupModel
forall {s}. WidgetData s ColorPopupModel
model ColorPopupEnv -> ColorPopupModel -> ColorPopupNode
uiBuilder ColorPopupEnv
-> ColorPopupNode
-> ColorPopupModel
-> ColorPopupEvt
-> [EventResponse ColorPopupModel ColorPopupEvt s e]
eventHandler [CompositeCfg ColorPopupModel ColorPopupEvt s e]
forall {e} {ep}. [CompositeCfg ColorPopupModel e s ep]
compCfg

buildUI
  :: WidgetModel sp
  => ColorPopupCfg sp ep
  -> ColorPopupEnv
  -> ColorPopupModel
  -> ColorPopupNode
buildUI :: forall sp ep.
WidgetModel sp =>
ColorPopupCfg sp ep
-> ColorPopupEnv -> ColorPopupModel -> ColorPopupNode
buildUI ColorPopupCfg sp ep
config ColorPopupEnv
wenv ColorPopupModel
model = ColorPopupNode
widgetTree where
  containerStyle :: Style
containerStyle = ColorPopupEnv -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme ColorPopupEnv
wenv (StyleState -> f StyleState) -> ThemeState -> f ThemeState
forall s a. HasColorPopupStyle s a => Lens' s a
Lens' ThemeState StyleState
L.colorPopupStyle
  selColor :: Color
selColor = ColorPopupModel
model ColorPopupModel -> Getting Color ColorPopupModel Color -> Color
forall s a. s -> Getting a s a -> a
^. Getting Color ColorPopupModel Color
forall s a. HasPopupColor s a => Lens' s a
Lens' ColorPopupModel Color
popupColor

  toggleStyle :: Style
toggleStyle = Style -> Style
mergeBasicStyle (Style -> Style) -> Style -> Style
forall a b. (a -> b) -> a -> b
$ Style
forall a. Default a => a
def
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& (Maybe StyleState -> Identity (Maybe StyleState))
-> Style -> Identity Style
forall s a. HasBasic s a => Lens' s a
Lens' Style (Maybe StyleState)
L.basic ((Maybe StyleState -> Identity (Maybe StyleState))
 -> Style -> Identity Style)
-> ((Maybe SizeReq -> Identity (Maybe SizeReq))
    -> Maybe StyleState -> Identity (Maybe StyleState))
-> (Maybe SizeReq -> Identity (Maybe SizeReq))
-> Style
-> Identity Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleState -> Iso' (Maybe StyleState) StyleState
forall a. Eq a => a -> Iso' (Maybe a) a
non StyleState
forall a. Default a => a
def ((StyleState -> Identity StyleState)
 -> Maybe StyleState -> Identity (Maybe StyleState))
-> ((Maybe SizeReq -> Identity (Maybe SizeReq))
    -> StyleState -> Identity StyleState)
-> (Maybe SizeReq -> Identity (Maybe SizeReq))
-> Maybe StyleState
-> Identity (Maybe StyleState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe SizeReq -> Identity (Maybe SizeReq))
-> StyleState -> Identity StyleState
forall s a. HasSizeReqW s a => Lens' s a
Lens' StyleState (Maybe SizeReq)
L.sizeReqW ((Maybe SizeReq -> Identity (Maybe SizeReq))
 -> Style -> Identity Style)
-> SizeReq -> Style -> Style
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> SizeReq
forall t. CmbWidth t => Double -> t
width Double
30
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& (Maybe StyleState -> Identity (Maybe StyleState))
-> Style -> Identity Style
forall s a. HasBasic s a => Lens' s a
Lens' Style (Maybe StyleState)
L.basic ((Maybe StyleState -> Identity (Maybe StyleState))
 -> Style -> Identity Style)
-> ((Maybe SizeReq -> Identity (Maybe SizeReq))
    -> Maybe StyleState -> Identity (Maybe StyleState))
-> (Maybe SizeReq -> Identity (Maybe SizeReq))
-> Style
-> Identity Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleState -> Iso' (Maybe StyleState) StyleState
forall a. Eq a => a -> Iso' (Maybe a) a
non StyleState
forall a. Default a => a
def ((StyleState -> Identity StyleState)
 -> Maybe StyleState -> Identity (Maybe StyleState))
-> ((Maybe SizeReq -> Identity (Maybe SizeReq))
    -> StyleState -> Identity StyleState)
-> (Maybe SizeReq -> Identity (Maybe SizeReq))
-> Maybe StyleState
-> Identity (Maybe StyleState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe SizeReq -> Identity (Maybe SizeReq))
-> StyleState -> Identity StyleState
forall s a. HasSizeReqH s a => Lens' s a
Lens' StyleState (Maybe SizeReq)
L.sizeReqH ((Maybe SizeReq -> Identity (Maybe SizeReq))
 -> Style -> Identity Style)
-> SizeReq -> Style -> Style
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> SizeReq
forall t. CmbHeight t => Double -> t
height Double
30
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& (Maybe StyleState -> Identity (Maybe StyleState))
-> Style -> Identity Style
forall s a. HasBasic s a => Lens' s a
Lens' Style (Maybe StyleState)
L.basic ((Maybe StyleState -> Identity (Maybe StyleState))
 -> Style -> Identity Style)
-> ((Maybe Color -> Identity (Maybe Color))
    -> Maybe StyleState -> Identity (Maybe StyleState))
-> (Maybe Color -> Identity (Maybe Color))
-> Style
-> Identity Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleState -> Iso' (Maybe StyleState) StyleState
forall a. Eq a => a -> Iso' (Maybe a) a
non StyleState
forall a. Default a => a
def ((StyleState -> Identity StyleState)
 -> Maybe StyleState -> Identity (Maybe StyleState))
-> ((Maybe Color -> Identity (Maybe Color))
    -> StyleState -> Identity StyleState)
-> (Maybe Color -> Identity (Maybe Color))
-> Maybe StyleState
-> Identity (Maybe StyleState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Color -> Identity (Maybe Color))
-> StyleState -> Identity StyleState
forall s a. HasBgColor s a => Lens' s a
Lens' StyleState (Maybe Color)
L.bgColor ((Maybe Color -> Identity (Maybe Color))
 -> Style -> Identity Style)
-> Color -> Style -> Style
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Color
selColor
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& (Maybe StyleState -> Identity (Maybe StyleState))
-> Style -> Identity Style
forall s a. HasBasic s a => Lens' s a
Lens' Style (Maybe StyleState)
L.basic ((Maybe StyleState -> Identity (Maybe StyleState))
 -> Style -> Identity Style)
-> ((Maybe Border -> Identity (Maybe Border))
    -> Maybe StyleState -> Identity (Maybe StyleState))
-> (Maybe Border -> Identity (Maybe Border))
-> Style
-> Identity Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleState -> Iso' (Maybe StyleState) StyleState
forall a. Eq a => a -> Iso' (Maybe a) a
non StyleState
forall a. Default a => a
def ((StyleState -> Identity StyleState)
 -> Maybe StyleState -> Identity (Maybe StyleState))
-> ((Maybe Border -> Identity (Maybe Border))
    -> StyleState -> Identity StyleState)
-> (Maybe Border -> Identity (Maybe Border))
-> Maybe StyleState
-> Identity (Maybe StyleState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Border -> Identity (Maybe Border))
-> StyleState -> Identity StyleState
forall s a. HasBorder s a => Lens' s a
Lens' StyleState (Maybe Border)
L.border ((Maybe Border -> Identity (Maybe Border))
 -> Style -> Identity Style)
-> Border -> Style -> Style
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> Color -> Border
forall t. CmbBorder t => Double -> Color -> t
border Double
1 Color
selColor

  toggleCfg :: [ToggleButtonCfg s e]
toggleCfg = [Style -> ToggleButtonCfg s e
forall s e. Style -> ToggleButtonCfg s e
toggleButtonOffStyle Style
toggleStyle]
  toggle :: WidgetNode ColorPopupModel e
toggle = Text
-> ALens' ColorPopupModel Bool
-> [ToggleButtonCfg ColorPopupModel e]
-> WidgetNode ColorPopupModel e
forall s e.
Text -> ALens' s Bool -> [ToggleButtonCfg s e] -> WidgetNode s e
toggleButton_ Text
"" ALens' ColorPopupModel Bool
forall s a. HasPopupShowColor s a => Lens' s a
Lens' ColorPopupModel Bool
popupShowColor [ToggleButtonCfg ColorPopupModel e]
forall {s} {e}. [ToggleButtonCfg s e]
toggleCfg
    WidgetNode ColorPopupModel e
-> (WidgetNode ColorPopupModel e -> WidgetNode ColorPopupModel e)
-> WidgetNode ColorPopupModel e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode ColorPopupModel e
-> Identity (WidgetNode ColorPopupModel e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode ColorPopupModel e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode ColorPopupModel e
 -> Identity (WidgetNode ColorPopupModel e))
-> ((Style -> Identity Style)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Style -> Identity Style)
-> WidgetNode ColorPopupModel e
-> Identity (WidgetNode ColorPopupModel e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
Lens' WidgetNodeInfo Style
L.style ((Style -> Identity Style)
 -> WidgetNode ColorPopupModel e
 -> Identity (WidgetNode ColorPopupModel e))
-> Style
-> WidgetNode ColorPopupModel e
-> WidgetNode ColorPopupModel e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
toggleStyle

  pickerCfg :: ColorPickerCfg ColorPopupModel ColorPopupEvt
pickerCfg = ColorPopupCfg sp ep -> ColorPickerCfg ColorPopupModel ColorPopupEvt
forall s e.
ColorPopupCfg s e -> ColorPickerCfg ColorPopupModel ColorPopupEvt
_cpcColorPickerCfg ColorPopupCfg sp ep
config
  picker :: ColorPopupNode
picker = ALens' ColorPopupModel Color
-> [ColorPickerCfg ColorPopupModel ColorPopupEvt] -> ColorPopupNode
forall s e.
(WidgetModel s, WidgetEvent e) =>
ALens' s Color -> [ColorPickerCfg s e] -> WidgetNode s e
colorPicker_ ALens' ColorPopupModel Color
forall s a. HasPopupColor s a => Lens' s a
Lens' ColorPopupModel Color
popupColor [ColorPickerCfg ColorPopupModel ColorPopupEvt
pickerCfg, (Color -> ColorPopupEvt)
-> ColorPickerCfg ColorPopupModel ColorPopupEvt
forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange Color -> ColorPopupEvt
ColorChanged]
    ColorPopupNode
-> (ColorPopupNode -> ColorPopupNode) -> ColorPopupNode
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> ColorPopupNode -> Identity ColorPopupNode
forall s a. HasInfo s a => Lens' s a
Lens' ColorPopupNode WidgetNodeInfo
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> ColorPopupNode -> Identity ColorPopupNode)
-> ((Style -> Identity Style)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Style -> Identity Style)
-> ColorPopupNode
-> Identity ColorPopupNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
Lens' WidgetNodeInfo Style
L.style ((Style -> Identity Style)
 -> ColorPopupNode -> Identity ColorPopupNode)
-> Style -> ColorPopupNode -> ColorPopupNode
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
containerStyle

  content :: ColorPopupNode
content = ColorPopupNode -> ColorPopupNode
forall s e. WidgetNode s e -> WidgetNode s e
boxShadow ColorPopupNode
picker
  popupCfg :: [PopupCfg s e]
popupCfg = [PopupCfg s e
forall s e. PopupCfg s e
popupAlignToOuterV, Point -> PopupCfg s e
forall s e. Point -> PopupCfg s e
popupOffset (Double -> Double -> Point
Point Double
0 Double
10), PopupCfg s e
forall t. CmbAlignBottom t => t
alignBottom, PopupCfg s e
forall t. CmbAlignLeft t => t
alignLeft]
  widgetTree :: ColorPopupNode
widgetTree = ALens' ColorPopupModel Bool
-> [PopupCfg ColorPopupModel ColorPopupEvt]
-> ColorPopupNode
-> ColorPopupNode
forall s e.
WidgetModel s =>
ALens' s Bool -> [PopupCfg s e] -> WidgetNode s e -> WidgetNode s e
popup_ ALens' ColorPopupModel Bool
forall s a. HasPopupShowColor s a => Lens' s a
Lens' ColorPopupModel Bool
popupShowColor (ColorPopupNode -> PopupCfg ColorPopupModel ColorPopupEvt
forall s e. WidgetNode s e -> PopupCfg s e
popupAnchor ColorPopupNode
forall {e}. WidgetNode ColorPopupModel e
toggle PopupCfg ColorPopupModel ColorPopupEvt
-> [PopupCfg ColorPopupModel ColorPopupEvt]
-> [PopupCfg ColorPopupModel ColorPopupEvt]
forall a. a -> [a] -> [a]
: [PopupCfg ColorPopupModel ColorPopupEvt]
forall {s} {e}. [PopupCfg s e]
popupCfg) ColorPopupNode
content

handleEvent
  :: WidgetModel sp
  => WidgetData sp Color
  -> ColorPopupCfg sp ep
  -> ColorPopupEnv
  -> ColorPopupNode
  -> ColorPopupModel
  -> ColorPopupEvt
  -> [EventResponse ColorPopupModel ColorPopupEvt sp ep]
handleEvent :: forall sp ep.
WidgetModel sp =>
WidgetData sp Color
-> ColorPopupCfg sp ep
-> ColorPopupEnv
-> ColorPopupNode
-> ColorPopupModel
-> ColorPopupEvt
-> [EventResponse ColorPopupModel ColorPopupEvt sp ep]
handleEvent WidgetData sp Color
wdata ColorPopupCfg sp ep
cfg ColorPopupEnv
wenv ColorPopupNode
node ColorPopupModel
model ColorPopupEvt
evt = case ColorPopupEvt
evt of
  PopupFocus Path
prev
    | Bool -> Bool
not (ColorPopupNode -> Path -> Bool
forall s e. WidgetNode s e -> Path -> Bool
isNodeParentOfPath ColorPopupNode
node Path
prev) -> Path -> [EventResponse ColorPopupModel ColorPopupEvt sp ep]
forall {s} {e}. Path -> [EventResponse s e sp ep]
reportFocus Path
prev
  PopupBlur Path
next
    | Bool -> Bool
not (ColorPopupNode -> Path -> Bool
forall s e. WidgetNode s e -> Path -> Bool
isNodeParentOfPath ColorPopupNode
node Path
next) -> Path -> [EventResponse ColorPopupModel ColorPopupEvt sp ep]
forall {s} {e}. Path -> [EventResponse s e sp ep]
reportBlur Path
next
  ColorChanged Color
col -> Color -> [EventResponse ColorPopupModel ColorPopupEvt sp ep]
forall {s} {e}. Color -> [EventResponse s e sp ep]
reportChange Color
col
  ColorPopupEvt
_ -> []
  where
    parentColor :: sp -> Color
parentColor sp
pm = sp -> WidgetData sp Color -> Color
forall s a. s -> WidgetData s a -> a
widgetDataGet sp
pm WidgetData sp Color
wdata
    parentChanged :: sp -> Bool
parentChanged sp
pm = sp -> Color
parentColor sp
pm Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
/= ColorPopupModel
model ColorPopupModel -> Getting Color ColorPopupModel Color -> Color
forall s a. s -> Getting a s a -> a
^. Getting Color ColorPopupModel Color
forall s a. HasPopupColor s a => Lens' s a
Lens' ColorPopupModel Color
popupColor

    report :: f (WidgetRequest sp ep) -> f (EventResponse s e sp ep)
report f (WidgetRequest sp ep)
reqs = WidgetRequest sp ep -> EventResponse s e sp ep
forall s e sp ep. WidgetRequest sp ep -> EventResponse s e sp ep
RequestParent (WidgetRequest sp ep -> EventResponse s e sp ep)
-> f (WidgetRequest sp ep) -> f (EventResponse s e sp ep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (WidgetRequest sp ep)
reqs
    reportFocus :: Path -> [EventResponse s e sp ep]
reportFocus Path
prev = [WidgetRequest sp ep] -> [EventResponse s e sp ep]
forall {f :: * -> *} {sp} {ep} {s} {e}.
Functor f =>
f (WidgetRequest sp ep) -> f (EventResponse s e sp ep)
report (((Path -> WidgetRequest sp ep) -> Path -> WidgetRequest sp ep
forall a b. (a -> b) -> a -> b
$ Path
prev) ((Path -> WidgetRequest sp ep) -> WidgetRequest sp ep)
-> [Path -> WidgetRequest sp ep] -> [WidgetRequest sp ep]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColorPopupCfg sp ep -> [Path -> WidgetRequest sp ep]
forall s e. ColorPopupCfg s e -> [Path -> WidgetRequest s e]
_cpcOnFocusReq ColorPopupCfg sp ep
cfg)
    reportBlur :: Path -> [EventResponse s e sp ep]
reportBlur Path
next = [WidgetRequest sp ep] -> [EventResponse s e sp ep]
forall {f :: * -> *} {sp} {ep} {s} {e}.
Functor f =>
f (WidgetRequest sp ep) -> f (EventResponse s e sp ep)
report (((Path -> WidgetRequest sp ep) -> Path -> WidgetRequest sp ep
forall a b. (a -> b) -> a -> b
$ Path
next) ((Path -> WidgetRequest sp ep) -> WidgetRequest sp ep)
-> [Path -> WidgetRequest sp ep] -> [WidgetRequest sp ep]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColorPopupCfg sp ep -> [Path -> WidgetRequest sp ep]
forall s e. ColorPopupCfg s e -> [Path -> WidgetRequest s e]
_cpcOnBlurReq ColorPopupCfg sp ep
cfg)
    reportChange :: Color -> [EventResponse s e sp ep]
reportChange Color
col = [WidgetRequest sp ep] -> [EventResponse s e sp ep]
forall {f :: * -> *} {sp} {ep} {s} {e}.
Functor f =>
f (WidgetRequest sp ep) -> f (EventResponse s e sp ep)
report ([WidgetRequest sp ep]
forall {e}. [WidgetRequest sp e]
wdataReqs [WidgetRequest sp ep]
-> [WidgetRequest sp ep] -> [WidgetRequest sp ep]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest sp ep]
changeReqs) where
      wdataReqs :: [WidgetRequest sp e]
wdataReqs = WidgetData sp Color -> Color -> [WidgetRequest sp e]
forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetData sp Color
wdata Color
col
      changeReqs :: [WidgetRequest sp ep]
changeReqs =  ((Color -> WidgetRequest sp ep) -> Color -> WidgetRequest sp ep
forall a b. (a -> b) -> a -> b
$ Color
col) ((Color -> WidgetRequest sp ep) -> WidgetRequest sp ep)
-> [Color -> WidgetRequest sp ep] -> [WidgetRequest sp ep]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColorPopupCfg sp ep -> [Color -> WidgetRequest sp ep]
forall s e. ColorPopupCfg s e -> [Color -> WidgetRequest s e]
_cpcOnChangeReq ColorPopupCfg sp ep
cfg