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

Provides a base theme, with fixed sizes and padding but configurable colors.
-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Monomer.Core.Themes.BaseTheme (
  BaseThemeColors(..),
  baseTheme
) where

import Control.Lens ((&), (^.), (.~), (?~), non)
import Data.Default

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

import qualified Monomer.Core.Lens as L
import qualified Monomer.Graphics.Lens as L

-- | Creates a theme using the provided colors.
baseTheme :: BaseThemeColors -> Theme
baseTheme :: BaseThemeColors -> Theme
baseTheme BaseThemeColors
themeMod = Theme {
  _themeClearColor :: Color
_themeClearColor = BaseThemeColors -> Color
clearColor BaseThemeColors
themeMod,
  _themeSectionColor :: Color
_themeSectionColor = BaseThemeColors -> Color
sectionColor BaseThemeColors
themeMod,
  _themeUserColorMap :: Map String Color
_themeUserColorMap = forall a. Default a => a
def,
  _themeBasic :: ThemeState
_themeBasic = BaseThemeColors -> ThemeState
baseBasic BaseThemeColors
themeMod,
  _themeHover :: ThemeState
_themeHover = BaseThemeColors -> ThemeState
baseHover BaseThemeColors
themeMod,
  _themeFocus :: ThemeState
_themeFocus = BaseThemeColors -> ThemeState
baseFocus BaseThemeColors
themeMod,
  _themeFocusHover :: ThemeState
_themeFocusHover = BaseThemeColors -> ThemeState
baseFocusHover BaseThemeColors
themeMod,
  _themeActive :: ThemeState
_themeActive = BaseThemeColors -> ThemeState
baseActive BaseThemeColors
themeMod,
  _themeDisabled :: ThemeState
_themeDisabled = BaseThemeColors -> ThemeState
baseDisabled BaseThemeColors
themeMod
}

-- | Customizable colors for the theme.
data BaseThemeColors = BaseThemeColors {
  BaseThemeColors -> Color
clearColor :: Color,
  BaseThemeColors -> Color
sectionColor :: Color,
  BaseThemeColors -> Color
btnFocusBorder :: Color,
  BaseThemeColors -> Color
btnBgBasic :: Color,
  BaseThemeColors -> Color
btnBgHover :: Color,
  BaseThemeColors -> Color
btnBgFocus :: Color,
  BaseThemeColors -> Color
btnBgActive :: Color,
  BaseThemeColors -> Color
btnBgDisabled :: Color,
  BaseThemeColors -> Color
btnText :: Color,
  BaseThemeColors -> Color
btnTextDisabled :: Color,
  BaseThemeColors -> Color
btnMainFocusBorder :: Color,
  BaseThemeColors -> Color
btnMainBgBasic :: Color,
  BaseThemeColors -> Color
btnMainBgHover :: Color,
  BaseThemeColors -> Color
btnMainBgFocus :: Color,
  BaseThemeColors -> Color
btnMainBgActive :: Color,
  BaseThemeColors -> Color
btnMainBgDisabled :: Color,
  BaseThemeColors -> Color
btnMainText :: Color,
  BaseThemeColors -> Color
btnMainTextDisabled :: Color,
  BaseThemeColors -> Color
dialogBg :: Color,
  BaseThemeColors -> Color
dialogBorder :: Color,
  BaseThemeColors -> Color
dialogText :: Color,
  BaseThemeColors -> Color
dialogTitleText :: Color,
  BaseThemeColors -> Color
emptyOverlay :: Color,
  BaseThemeColors -> Color
shadow :: Color,
  BaseThemeColors -> Color
externalLinkBasic :: Color,
  BaseThemeColors -> Color
externalLinkHover :: Color,
  BaseThemeColors -> Color
externalLinkFocus :: Color,
  BaseThemeColors -> Color
externalLinkActive :: Color,
  BaseThemeColors -> Color
externalLinkDisabled :: Color,
  BaseThemeColors -> Color
iconFg :: Color,
  BaseThemeColors -> Color
iconBg :: Color,
  BaseThemeColors -> Color
inputIconFg :: Color,
  BaseThemeColors -> Color
inputBorder :: Color,
  BaseThemeColors -> Color
inputFocusBorder :: Color,
  BaseThemeColors -> Color
inputBgBasic :: Color,
  BaseThemeColors -> Color
inputBgHover :: Color,
  BaseThemeColors -> Color
inputBgFocus :: Color,
  BaseThemeColors -> Color
inputBgActive :: Color,
  BaseThemeColors -> Color
inputBgDisabled :: Color,
  BaseThemeColors -> Color
inputFgBasic :: Color,
  BaseThemeColors -> Color
inputFgHover :: Color,
  BaseThemeColors -> Color
inputFgFocus :: Color,
  BaseThemeColors -> Color
inputFgActive :: Color,
  BaseThemeColors -> Color
inputFgDisabled :: Color,
  BaseThemeColors -> Color
inputSndBasic :: Color,
  BaseThemeColors -> Color
inputSndHover :: Color,
  BaseThemeColors -> Color
inputSndFocus :: Color,
  BaseThemeColors -> Color
inputSndActive :: Color,
  BaseThemeColors -> Color
inputSndDisabled :: Color,
  BaseThemeColors -> Color
inputHlBasic :: Color,
  BaseThemeColors -> Color
inputHlHover :: Color,
  BaseThemeColors -> Color
inputHlFocus :: Color,
  BaseThemeColors -> Color
inputHlActive :: Color,
  BaseThemeColors -> Color
inputHlDisabled :: Color,
  BaseThemeColors -> Color
inputSelBasic :: Color,
  BaseThemeColors -> Color
inputSelFocus :: Color,
  BaseThemeColors -> Color
inputText :: Color,
  BaseThemeColors -> Color
inputTextDisabled :: Color,
  BaseThemeColors -> Color
labelText :: Color,
  BaseThemeColors -> Color
scrollBarBasic :: Color,
  BaseThemeColors -> Color
scrollThumbBasic :: Color,
  BaseThemeColors -> Color
scrollBarHover :: Color,
  BaseThemeColors -> Color
scrollThumbHover :: Color,
  BaseThemeColors -> Color
slMainBg :: Color,
  BaseThemeColors -> Color
slNormalBgBasic :: Color,
  BaseThemeColors -> Color
slNormalBgHover :: Color,
  BaseThemeColors -> Color
slNormalText :: Color,
  BaseThemeColors -> Color
slNormalFocusBorder :: Color,
  BaseThemeColors -> Color
slSelectedBgBasic :: Color,
  BaseThemeColors -> Color
slSelectedBgHover :: Color,
  BaseThemeColors -> Color
slSelectedText :: Color,
  BaseThemeColors -> Color
slSelectedFocusBorder :: Color,
  BaseThemeColors -> Color
tooltipBorder :: Color,
  BaseThemeColors -> Color
tooltipBg :: Color,
  BaseThemeColors -> Color
tooltipText :: Color
} deriving (BaseThemeColors -> BaseThemeColors -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BaseThemeColors -> BaseThemeColors -> Bool
$c/= :: BaseThemeColors -> BaseThemeColors -> Bool
== :: BaseThemeColors -> BaseThemeColors -> Bool
$c== :: BaseThemeColors -> BaseThemeColors -> Bool
Eq, Int -> BaseThemeColors -> ShowS
[BaseThemeColors] -> ShowS
BaseThemeColors -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BaseThemeColors] -> ShowS
$cshowList :: [BaseThemeColors] -> ShowS
show :: BaseThemeColors -> String
$cshow :: BaseThemeColors -> String
showsPrec :: Int -> BaseThemeColors -> ShowS
$cshowsPrec :: Int -> BaseThemeColors -> ShowS
Show)

btnBorderFocus :: BaseThemeColors -> Border
btnBorderFocus :: BaseThemeColors -> Border
btnBorderFocus BaseThemeColors
themeMod = forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
btnFocusBorder BaseThemeColors
themeMod)

btnMainBorderFocus :: BaseThemeColors -> Border
btnMainBorderFocus :: BaseThemeColors -> Border
btnMainBorderFocus BaseThemeColors
themeMod = forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
btnMainFocusBorder BaseThemeColors
themeMod)

inputBorderFocus :: BaseThemeColors -> Border
inputBorderFocus :: BaseThemeColors -> Border
inputBorderFocus BaseThemeColors
themeMod = forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
inputFocusBorder BaseThemeColors
themeMod)

normalFont :: TextStyle
normalFont :: TextStyle
normalFont = forall a. Default a => a
def
  forall a b. a -> (a -> b) -> b
& forall s a. HasFont s a => Lens' s a
L.font forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Font
Font Text
"Regular"
  forall a b. a -> (a -> b) -> b
& forall s a. HasFontSize s a => Lens' s a
L.fontSize forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> FontSize
FontSize Double
16
  forall a b. a -> (a -> b) -> b
& forall s a. HasFontSpaceV s a => Lens' s a
L.fontSpaceV forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> FontSpace
FontSpace Double
2

titleFont :: TextStyle
titleFont :: TextStyle
titleFont = forall a. Default a => a
def
  forall a b. a -> (a -> b) -> b
& forall s a. HasFont s a => Lens' s a
L.font forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Font
Font Text
"Bold"
  forall a b. a -> (a -> b) -> b
& forall s a. HasFontSize s a => Lens' s a
L.fontSize forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> FontSize
FontSize Double
20
  forall a b. a -> (a -> b) -> b
& forall s a. HasFontSpaceV s a => Lens' s a
L.fontSpaceV forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> FontSpace
FontSpace Double
2

dialogMsgBodyFont :: BaseThemeColors -> TextStyle
dialogMsgBodyFont :: BaseThemeColors -> TextStyle
dialogMsgBodyFont BaseThemeColors
themeMod = TextStyle
fontStyle where
  fontStyle :: TextStyle
fontStyle = TextStyle
normalFont
    forall a b. a -> (a -> b) -> b
& forall s a. HasFontColor s a => Lens' s a
L.fontColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
dialogText BaseThemeColors
themeMod

externalLinkFont :: BaseThemeColors -> TextStyle
externalLinkFont :: BaseThemeColors -> TextStyle
externalLinkFont BaseThemeColors
themeMod = TextStyle
fontStyle where
  fontStyle :: TextStyle
fontStyle = TextStyle
normalFont
    forall a b. a -> (a -> b) -> b
& forall s a. HasFontColor s a => Lens' s a
L.fontColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
externalLinkBasic BaseThemeColors
themeMod

labelFont :: BaseThemeColors -> TextStyle
labelFont :: BaseThemeColors -> TextStyle
labelFont BaseThemeColors
themeMod = TextStyle
fontStyle forall a. Semigroup a => a -> a -> a
<> forall t. CmbTextLeft t => t
textLeft where
  fontStyle :: TextStyle
fontStyle = TextStyle
normalFont
    forall a b. a -> (a -> b) -> b
& forall s a. HasFontColor s a => Lens' s a
L.fontColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
labelText BaseThemeColors
themeMod

btnStyle :: BaseThemeColors -> StyleState
btnStyle :: BaseThemeColors -> StyleState
btnStyle BaseThemeColors
themeMod = forall a. Default a => a
def
  forall a b. a -> (a -> b) -> b
& forall s a. HasText s a => Lens' s a
L.text forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (TextStyle
normalFont forall a b. a -> (a -> b) -> b
& forall s a. HasFontColor s a => Lens' s a
L.fontColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnText BaseThemeColors
themeMod) forall a. Semigroup a => a -> a -> a
<> forall t. CmbTextCenter t => t
textCenter
  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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnBgBasic BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
btnBgBasic BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasPadding s a => Lens' s a
L.padding forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbPadding t => Double -> t
padding Double
8
  forall a b. a -> (a -> b) -> b
& forall s a. HasRadius s a => Lens' s a
L.radius forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbRadius t => Double -> t
radius Double
4

btnMainStyle :: BaseThemeColors -> StyleState
btnMainStyle :: BaseThemeColors -> StyleState
btnMainStyle BaseThemeColors
themeMod = BaseThemeColors -> StyleState
btnStyle BaseThemeColors
themeMod
  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. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainText BaseThemeColors
themeMod
  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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainBgBasic BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
btnMainBgBasic BaseThemeColors
themeMod)

textInputStyle :: BaseThemeColors -> StyleState
textInputStyle :: BaseThemeColors -> StyleState
textInputStyle BaseThemeColors
themeMod = StyleState
style where
  textStyle :: TextStyle
textStyle = TextStyle
normalFont
    forall a b. a -> (a -> b) -> b
& forall s a. HasFontColor s a => Lens' s a
L.fontColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputText BaseThemeColors
themeMod
  style :: StyleState
style = forall a. Default a => a
def
    forall a b. a -> (a -> b) -> b
& forall s a. HasText s a => Lens' s a
L.text forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ TextStyle
textStyle
    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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputBgBasic BaseThemeColors
themeMod
    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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgBasic BaseThemeColors
themeMod
    forall a b. a -> (a -> b) -> b
& forall s a. HasSndColor s a => Lens' s a
L.sndColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (BaseThemeColors -> Color
inputSndBasic BaseThemeColors
themeMod forall a b. a -> (a -> b) -> b
& forall s a. HasA s a => Lens' s a
L.a forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.6)
    forall a b. a -> (a -> b) -> b
& forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSelBasic BaseThemeColors
themeMod
    forall a b. a -> (a -> b) -> b
& forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
inputBorder BaseThemeColors
themeMod)
    forall a b. a -> (a -> b) -> b
& forall s a. HasRadius s a => Lens' s a
L.radius forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbRadius t => Double -> t
radius Double
4
    forall a b. a -> (a -> b) -> b
& forall s a. HasPadding s a => Lens' s a
L.padding forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbPadding t => Double -> t
padding Double
8

numericInputStyle :: BaseThemeColors -> StyleState
numericInputStyle :: BaseThemeColors -> StyleState
numericInputStyle BaseThemeColors
themeMod = BaseThemeColors -> StyleState
textInputStyle BaseThemeColors
themeMod
  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. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasAlignH s a => Lens' s a
L.alignH forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ AlignTH
ATRight

dateInputStyle :: BaseThemeColors -> StyleState
dateInputStyle :: BaseThemeColors -> StyleState
dateInputStyle BaseThemeColors
themeMod = BaseThemeColors -> StyleState
textInputStyle BaseThemeColors
themeMod
  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. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasAlignH s a => Lens' s a
L.alignH forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ AlignTH
ATRight

timeInputStyle :: BaseThemeColors -> StyleState
timeInputStyle :: BaseThemeColors -> StyleState
timeInputStyle BaseThemeColors
themeMod = BaseThemeColors -> StyleState
textInputStyle BaseThemeColors
themeMod
  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. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasAlignH s a => Lens' s a
L.alignH forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ AlignTH
ATRight

selectListItemStyle :: BaseThemeColors -> StyleState
selectListItemStyle :: BaseThemeColors -> StyleState
selectListItemStyle BaseThemeColors
themeMod = forall a. Default a => a
def
  forall a b. a -> (a -> b) -> b
& forall s a. HasText s a => Lens' s a
L.text forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (TextStyle
normalFont forall a b. a -> (a -> b) -> b
& forall s a. HasFontColor s a => Lens' s a
L.fontColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
slNormalText BaseThemeColors
themeMod)
  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. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasAlignH s a => Lens' s a
L.alignH forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ AlignTH
ATLeft
  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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
slNormalBgBasic BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
slNormalBgBasic BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasPadding s a => Lens' s a
L.padding forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbPadding t => Double -> t
padding Double
8

selectListItemSelectedStyle :: BaseThemeColors -> StyleState
selectListItemSelectedStyle :: BaseThemeColors -> StyleState
selectListItemSelectedStyle BaseThemeColors
themeMod = BaseThemeColors -> StyleState
selectListItemStyle BaseThemeColors
themeMod
  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. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
slSelectedText BaseThemeColors
themeMod
  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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
slSelectedBgBasic BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
slSelectedBgBasic BaseThemeColors
themeMod)

tooltipStyle :: BaseThemeColors -> StyleState
tooltipStyle :: BaseThemeColors -> StyleState
tooltipStyle BaseThemeColors
themeMod = forall a. Default a => a
def
  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. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFont s a => Lens' s a
L.font forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Font
Font Text
"Regular"
  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. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFontSize s a => Lens' s a
L.fontSize forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> FontSize
FontSize Double
14
  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. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
tooltipText BaseThemeColors
themeMod
  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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
tooltipBg BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
tooltipBorder BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasPadding s a => Lens' s a
L.padding forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbPadding t => Double -> t
padding Double
6
  forall a b. a -> (a -> b) -> b
& forall s a. HasRadius s a => Lens' s a
L.radius forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbRadius t => Double -> t
radius Double
4

baseBasic :: BaseThemeColors -> ThemeState
baseBasic :: BaseThemeColors -> ThemeState
baseBasic BaseThemeColors
themeMod = forall a. Default a => a
def
  forall a b. a -> (a -> b) -> b
& forall s a. HasEmptyOverlayStyle s a => Lens' s a
L.emptyOverlayStyle forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall t. CmbBgColor t => Color -> t
bgColor (BaseThemeColors -> Color
emptyOverlay BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasEmptyOverlayStyle s a => Lens' s a
L.emptyOverlayStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPadding s a => Lens' s a
L.padding forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbPadding t => Double -> t
padding Double
8
  forall a b. a -> (a -> b) -> b
& forall s a. HasShadowColor s a => Lens' s a
L.shadowColor forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> Color
shadow BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnStyle s a => Lens' s a
L.btnStyle forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> StyleState
btnStyle BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnMainStyle s a => Lens' s a
L.btnMainStyle forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> StyleState
btnMainStyle BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasCheckboxWidth s a => Lens' s a
L.checkboxWidth forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
20
  forall a b. a -> (a -> b) -> b
& forall s a. HasCheckboxStyle s a => Lens' s a
L.checkboxStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgBasic BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasCheckboxStyle s a => Lens' s a
L.checkboxStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputHlBasic BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasCheckboxStyle s a => Lens' s a
L.checkboxStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasRadius s a => Lens' s a
L.radius forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbRadius t => Double -> t
radius Double
4
  forall a b. a -> (a -> b) -> b
& forall s a. HasDateFieldStyle s a => Lens' s a
L.dateFieldStyle forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> StyleState
dateInputStyle BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialWidth s a => Lens' s a
L.dialWidth forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
50
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialStyle s a => Lens' s a
L.dialStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgBasic BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialStyle s a => Lens' s a
L.dialStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSndColor s a => Lens' s a
L.sndColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSndBasic BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialogTitleStyle s a => Lens' s a
L.dialogTitleStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (TextStyle
titleFont forall a b. a -> (a -> b) -> b
& forall s a. HasFontColor s a => Lens' s a
L.fontColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
dialogTitleText BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialogTitleStyle s a => Lens' s a
L.dialogTitleStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPadding s a => Lens' s a
L.padding forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbPadding t => Double -> t
padding Double
10
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialogFrameStyle s a => Lens' s a
L.dialogFrameStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPadding s a => Lens' s a
L.padding forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbPadding t => Double -> t
padding Double
5
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialogFrameStyle s a => Lens' s a
L.dialogFrameStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasRadius s a => Lens' s a
L.radius forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbRadius t => Double -> t
radius Double
10
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialogFrameStyle s a => Lens' s a
L.dialogFrameStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
dialogBg BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialogFrameStyle s a => Lens' s a
L.dialogFrameStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
dialogBorder BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialogCloseIconStyle s a => Lens' s a
L.dialogCloseIconStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
iconBg BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialogCloseIconStyle s a => Lens' s a
L.dialogCloseIconStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
iconFg BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialogCloseIconStyle s a => Lens' s a
L.dialogCloseIconStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPadding s a => Lens' s a
L.padding forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbPadding t => Double -> t
padding Double
4
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialogCloseIconStyle s a => Lens' s a
L.dialogCloseIconStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasRadius s a => Lens' s a
L.radius forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbRadius t => Double -> t
radius Double
8
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialogCloseIconStyle s a => Lens' s a
L.dialogCloseIconStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbWidth t => Double -> t
width Double
16
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialogCloseIconStyle s a => Lens' s a
L.dialogCloseIconStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbWidth t => Double -> t
width Double
16
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialogButtonsStyle s a => Lens' s a
L.dialogButtonsStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPadding s a => Lens' s a
L.padding forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbPadding t => Double -> t
padding Double
20 forall a. Semigroup a => a -> a -> a
<> forall t. CmbPaddingT t => Double -> t
paddingT Double
10
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialogMsgBodyStyle s a => Lens' s a
L.dialogMsgBodyStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPadding s a => Lens' s a
L.padding forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbPadding t => Double -> t
padding Double
20
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialogMsgBodyStyle s a => Lens' s a
L.dialogMsgBodyStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> TextStyle
dialogMsgBodyFont BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialogMsgBodyStyle s a => Lens' s a
L.dialogMsgBodyStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbMaxWidth t => Double -> t
maxWidth Double
600
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownStyle s a => Lens' s a
L.dropdownStyle forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> StyleState
textInputStyle BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownStyle s a => Lens' s a
L.dropdownStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputIconFg BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownStyle s a => Lens' s a
L.dropdownStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasAlignH s a => Lens' s a
L.alignH forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ AlignTH
ATLeft
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownMaxHeight s a => Lens' s a
L.dropdownMaxHeight forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
200
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownListStyle s a => Lens' s a
L.dropdownListStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
slMainBg BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownItemStyle s a => Lens' s a
L.dropdownItemStyle forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> StyleState
selectListItemStyle BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownItemSelectedStyle s a => Lens' s a
L.dropdownItemSelectedStyle forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> StyleState
selectListItemSelectedStyle BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasExternalLinkStyle s a => Lens' s a
L.externalLinkStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> TextStyle
externalLinkFont BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasLabelStyle s a => Lens' s a
L.labelStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> TextStyle
labelFont BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasNumericFieldStyle s a => Lens' s a
L.numericFieldStyle forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> StyleState
numericInputStyle BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOnStyle s a => Lens' s a
L.optionBtnOnStyle forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> StyleState
btnMainStyle BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOffStyle s a => Lens' s a
L.optionBtnOffStyle forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> StyleState
btnStyle BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSelectListStyle s a => Lens' s a
L.selectListStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
slMainBg BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSelectListStyle s a => Lens' s a
L.selectListStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
slMainBg BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasSelectListItemStyle s a => Lens' s a
L.selectListItemStyle forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> StyleState
selectListItemStyle BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSelectListItemSelectedStyle s a => Lens' s a
L.selectListItemSelectedStyle forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> StyleState
selectListItemSelectedStyle BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasRadioWidth s a => Lens' s a
L.radioWidth forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
20
  forall a b. a -> (a -> b) -> b
& forall s a. HasRadioStyle s a => Lens' s a
L.radioStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgBasic BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasRadioStyle s a => Lens' s a
L.radioStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputHlBasic BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasScrollOverlay s a => Lens' s a
L.scrollOverlay forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
  forall a b. a -> (a -> b) -> b
& forall s a. HasScrollFollowFocus s a => Lens' s a
L.scrollFollowFocus forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
  forall a b. a -> (a -> b) -> b
& forall s a. HasScrollBarColor s a => Lens' s a
L.scrollBarColor forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> Color
scrollBarBasic BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasScrollThumbColor s a => Lens' s a
L.scrollThumbColor forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> Color
scrollThumbBasic BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasScrollBarWidth s a => Lens' s a
L.scrollBarWidth forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
8
  forall a b. a -> (a -> b) -> b
& forall s a. HasScrollThumbWidth s a => Lens' s a
L.scrollThumbWidth forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
8
  forall a b. a -> (a -> b) -> b
& forall s a. HasScrollThumbMinSize s a => Lens' s a
L.scrollThumbMinSize forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
25
  forall a b. a -> (a -> b) -> b
& forall s a. HasScrollThumbRadius s a => Lens' s a
L.scrollThumbRadius forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
4
  forall a b. a -> (a -> b) -> b
& forall s a. HasScrollWheelRate s a => Lens' s a
L.scrollWheelRate forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rational
10
  forall a b. a -> (a -> b) -> b
& forall s a. HasSeparatorLineWidth s a => Lens' s a
L.separatorLineWidth forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
1
  forall a b. a -> (a -> b) -> b
& forall s a. HasSeparatorLineStyle s a => Lens' s a
L.separatorLineStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSndBasic BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSliderRadius s a => Lens' s a
L.sliderRadius forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double
2
  forall a b. a -> (a -> b) -> b
& forall s a. HasSliderThumbFactor s a => Lens' s a
L.sliderThumbFactor forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
1.25
  forall a b. a -> (a -> b) -> b
& forall s a. HasSliderWidth s a => Lens' s a
L.sliderWidth forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
10
  forall a b. a -> (a -> b) -> b
& forall s a. HasSliderStyle s a => Lens' s a
L.sliderStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgBasic BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSliderStyle s a => Lens' s a
L.sliderStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputHlBasic BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSliderStyle s a => Lens' s a
L.sliderStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSndColor s a => Lens' s a
L.sndColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSndBasic BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTextAreaStyle s a => Lens' s a
L.textAreaStyle forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> StyleState
textInputStyle BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTextFieldStyle s a => Lens' s a
L.textFieldStyle forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> StyleState
textInputStyle BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTimeFieldStyle s a => Lens' s a
L.timeFieldStyle forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> StyleState
timeInputStyle BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOnStyle s a => Lens' s a
L.toggleBtnOnStyle forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> StyleState
btnMainStyle BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOffStyle s a => Lens' s a
L.toggleBtnOffStyle forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> StyleState
btnStyle BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTooltipStyle s a => Lens' s a
L.tooltipStyle forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> StyleState
tooltipStyle BaseThemeColors
themeMod

baseHover :: BaseThemeColors -> ThemeState
baseHover :: BaseThemeColors -> ThemeState
baseHover BaseThemeColors
themeMod = BaseThemeColors -> ThemeState
baseBasic BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnStyle s a => Lens' s a
L.btnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnBgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnStyle s a => Lens' s a
L.btnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
btnBgHover BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnStyle s a => Lens' s a
L.btnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorHand
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnMainStyle s a => Lens' s a
L.btnMainStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainBgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnMainStyle s a => Lens' s a
L.btnMainStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
btnMainBgHover BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnMainStyle s a => Lens' s a
L.btnMainStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorHand
  forall a b. a -> (a -> b) -> b
& forall s a. HasCheckboxStyle s a => Lens' s a
L.checkboxStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasCheckboxStyle s a => Lens' s a
L.checkboxStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputHlHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasCheckboxStyle s a => Lens' s a
L.checkboxStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorHand
  forall a b. a -> (a -> b) -> b
& forall s a. HasDateFieldStyle s a => Lens' s a
L.dateFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorIBeam
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialStyle s a => Lens' s a
L.dialStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialStyle s a => Lens' s a
L.dialStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSndColor s a => Lens' s a
L.sndColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSndHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialStyle s a => Lens' s a
L.dialStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorSizeV
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialogCloseIconStyle s a => Lens' s a
L.dialogCloseIconStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorHand
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownStyle s a => Lens' s a
L.dropdownStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputBgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownStyle s a => Lens' s a
L.dropdownStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorHand
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownListStyle s a => Lens' s a
L.dropdownListStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
slMainBg BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownItemStyle s a => Lens' s a
L.dropdownItemStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
slNormalBgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownItemStyle s a => Lens' s a
L.dropdownItemStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
slNormalBgHover BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownItemStyle s a => Lens' s a
L.dropdownItemStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorHand
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownItemSelectedStyle s a => Lens' s a
L.dropdownItemSelectedStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
slSelectedBgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownItemSelectedStyle s a => Lens' s a
L.dropdownItemSelectedStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
slSelectedBgHover BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownItemSelectedStyle s a => Lens' s a
L.dropdownItemSelectedStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorHand
  forall a b. a -> (a -> b) -> b
& forall s a. HasExternalLinkStyle s a => Lens' s a
L.externalLinkStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
externalLinkHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasExternalLinkStyle s a => Lens' s a
L.externalLinkStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUnderline s a => Lens' s a
L.underline forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
True
  forall a b. a -> (a -> b) -> b
& forall s a. HasExternalLinkStyle s a => Lens' s a
L.externalLinkStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorHand
  forall a b. a -> (a -> b) -> b
& forall s a. HasNumericFieldStyle s a => Lens' s a
L.numericFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorIBeam
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOnStyle s a => Lens' s a
L.optionBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainBgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOnStyle s a => Lens' s a
L.optionBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
btnMainBgHover BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOnStyle s a => Lens' s a
L.optionBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorHand
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOffStyle s a => Lens' s a
L.optionBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnBgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOffStyle s a => Lens' s a
L.optionBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
btnBgHover BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOffStyle s a => Lens' s a
L.optionBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorHand
  forall a b. a -> (a -> b) -> b
& forall s a. HasSelectListItemStyle s a => Lens' s a
L.selectListItemStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
slNormalBgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSelectListItemStyle s a => Lens' s a
L.selectListItemStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
slNormalBgHover BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasSelectListItemStyle s a => Lens' s a
L.selectListItemStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorHand
  forall a b. a -> (a -> b) -> b
& forall s a. HasSelectListItemSelectedStyle s a => Lens' s a
L.selectListItemSelectedStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
slSelectedBgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSelectListItemSelectedStyle s a => Lens' s a
L.selectListItemSelectedStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
slSelectedBgHover BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasSelectListItemSelectedStyle s a => Lens' s a
L.selectListItemSelectedStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorHand
  forall a b. a -> (a -> b) -> b
& forall s a. HasRadioStyle s a => Lens' s a
L.radioStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasRadioStyle s a => Lens' s a
L.radioStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputHlHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasRadioStyle s a => Lens' s a
L.radioStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorHand
  forall a b. a -> (a -> b) -> b
& forall s a. HasScrollBarColor s a => Lens' s a
L.scrollBarColor forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> Color
scrollBarHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasScrollThumbColor s a => Lens' s a
L.scrollThumbColor forall s t a b. ASetter s t a b -> b -> s -> t
.~ BaseThemeColors -> Color
scrollThumbHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSliderStyle s a => Lens' s a
L.sliderStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSliderStyle s a => Lens' s a
L.sliderStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputHlHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSliderStyle s a => Lens' s a
L.sliderStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSndColor s a => Lens' s a
L.sndColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSndHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSliderStyle s a => Lens' s a
L.sliderStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorHand
  forall a b. a -> (a -> b) -> b
& forall s a. HasTextAreaStyle s a => Lens' s a
L.textAreaStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorIBeam
  forall a b. a -> (a -> b) -> b
& forall s a. HasTextFieldStyle s a => Lens' s a
L.textFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorIBeam
  forall a b. a -> (a -> b) -> b
& forall s a. HasTimeFieldStyle s a => Lens' s a
L.timeFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorIBeam
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOnStyle s a => Lens' s a
L.toggleBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainBgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOnStyle s a => Lens' s a
L.toggleBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
btnMainBgHover BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOnStyle s a => Lens' s a
L.toggleBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorHand
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOffStyle s a => Lens' s a
L.toggleBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnBgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOffStyle s a => Lens' s a
L.toggleBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
btnBgHover BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOffStyle s a => Lens' s a
L.toggleBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CursorIcon
CursorHand

baseFocus :: BaseThemeColors -> ThemeState
baseFocus :: BaseThemeColors -> ThemeState
baseFocus BaseThemeColors
themeMod = BaseThemeColors -> ThemeState
baseBasic BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnStyle s a => Lens' s a
L.btnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnBgFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnStyle s a => Lens' s a
L.btnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
btnBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnMainStyle s a => Lens' s a
L.btnMainStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainBgFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnMainStyle s a => Lens' s a
L.btnMainStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
btnMainBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasCheckboxStyle s a => Lens' s a
L.checkboxStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasCheckboxStyle s a => Lens' s a
L.checkboxStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputHlFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDateFieldStyle s a => Lens' s a
L.dateFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
inputBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDateFieldStyle s a => Lens' s a
L.dateFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSelFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialStyle s a => Lens' s a
L.dialStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialStyle s a => Lens' s a
L.dialStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSndColor s a => Lens' s a
L.sndColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSndFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownStyle s a => Lens' s a
L.dropdownStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
inputBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownListStyle s a => Lens' s a
L.dropdownListStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
slMainBg BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownItemStyle s a => Lens' s a
L.dropdownItemStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
slNormalFocusBorder BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownItemSelectedStyle s a => Lens' s a
L.dropdownItemSelectedStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
slSelectedFocusBorder BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasExternalLinkStyle s a => Lens' s a
L.externalLinkStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
externalLinkFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasNumericFieldStyle s a => Lens' s a
L.numericFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
inputBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasNumericFieldStyle s a => Lens' s a
L.numericFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSelFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOnStyle s a => Lens' s a
L.optionBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainBgFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOnStyle s a => Lens' s a
L.optionBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
btnMainBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOffStyle s a => Lens' s a
L.optionBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnBgFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOffStyle s a => Lens' s a
L.optionBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
btnBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSelectListStyle s a => Lens' s a
L.selectListStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
inputBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSelectListItemStyle s a => Lens' s a
L.selectListItemStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
slNormalFocusBorder BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasSelectListItemSelectedStyle s a => Lens' s a
L.selectListItemSelectedStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
slSelectedFocusBorder BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasRadioStyle s a => Lens' s a
L.radioStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasRadioStyle s a => Lens' s a
L.radioStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputHlFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSliderStyle s a => Lens' s a
L.sliderStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSliderStyle s a => Lens' s a
L.sliderStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputHlFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSliderStyle s a => Lens' s a
L.sliderStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSndColor s a => Lens' s a
L.sndColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSndFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTextAreaStyle s a => Lens' s a
L.textAreaStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
inputBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTextAreaStyle s a => Lens' s a
L.textAreaStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSelFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTextFieldStyle s a => Lens' s a
L.textFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
inputBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTextFieldStyle s a => Lens' s a
L.textFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSelFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTimeFieldStyle s a => Lens' s a
L.timeFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
inputBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTimeFieldStyle s a => Lens' s a
L.timeFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSelFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOnStyle s a => Lens' s a
L.toggleBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainBgFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOnStyle s a => Lens' s a
L.toggleBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
btnMainBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOffStyle s a => Lens' s a
L.toggleBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnBgFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOffStyle s a => Lens' s a
L.toggleBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
btnBorderFocus BaseThemeColors
themeMod

baseFocusHover :: BaseThemeColors -> ThemeState
baseFocusHover :: BaseThemeColors -> ThemeState
baseFocusHover BaseThemeColors
themeMod = (BaseThemeColors -> ThemeState
baseHover BaseThemeColors
themeMod forall a. Semigroup a => a -> a -> a
<> BaseThemeColors -> ThemeState
baseFocus BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnStyle s a => Lens' s a
L.btnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnBgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnMainStyle s a => Lens' s a
L.btnMainStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainBgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownItemStyle s a => Lens' s a
L.dropdownItemStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
slNormalBgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownItemSelectedStyle s a => Lens' s a
L.dropdownItemSelectedStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
slSelectedBgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasExternalLinkStyle s a => Lens' s a
L.externalLinkStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
externalLinkHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOnStyle s a => Lens' s a
L.optionBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainBgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOffStyle s a => Lens' s a
L.optionBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnBgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOnStyle s a => Lens' s a
L.toggleBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainBgHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOffStyle s a => Lens' s a
L.toggleBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnBgHover BaseThemeColors
themeMod

baseActive :: BaseThemeColors -> ThemeState
baseActive :: BaseThemeColors -> ThemeState
baseActive BaseThemeColors
themeMod = BaseThemeColors -> ThemeState
baseFocusHover BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnStyle s a => Lens' s a
L.btnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnBgActive BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnStyle s a => Lens' s a
L.btnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
btnBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnMainStyle s a => Lens' s a
L.btnMainStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainBgActive BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnMainStyle s a => Lens' s a
L.btnMainStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
btnMainBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasCheckboxStyle s a => Lens' s a
L.checkboxStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgActive BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasCheckboxStyle s a => Lens' s a
L.checkboxStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputHlActive BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDateFieldStyle s a => Lens' s a
L.dateFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
inputBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDateFieldStyle s a => Lens' s a
L.dateFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSelFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialStyle s a => Lens' s a
L.dialStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgActive BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialStyle s a => Lens' s a
L.dialStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSndColor s a => Lens' s a
L.sndColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSndActive BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownStyle s a => Lens' s a
L.dropdownStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputBgActive BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownStyle s a => Lens' s a
L.dropdownStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
inputBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasExternalLinkStyle s a => Lens' s a
L.externalLinkStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
externalLinkActive BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasNumericFieldStyle s a => Lens' s a
L.numericFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
inputBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasNumericFieldStyle s a => Lens' s a
L.numericFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSelFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOnStyle s a => Lens' s a
L.optionBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainBgActive BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOnStyle s a => Lens' s a
L.optionBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
btnMainBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOffStyle s a => Lens' s a
L.optionBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnBgActive BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOffStyle s a => Lens' s a
L.optionBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
btnBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasRadioStyle s a => Lens' s a
L.radioStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgActive BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasRadioStyle s a => Lens' s a
L.radioStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputHlActive BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSliderStyle s a => Lens' s a
L.sliderStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgActive BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSliderStyle s a => Lens' s a
L.sliderStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputHlActive BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSliderStyle s a => Lens' s a
L.sliderStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSndColor s a => Lens' s a
L.sndColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSndActive BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTextAreaStyle s a => Lens' s a
L.textAreaStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
inputBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTextAreaStyle s a => Lens' s a
L.textAreaStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSelFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTextFieldStyle s a => Lens' s a
L.textFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
inputBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTextFieldStyle s a => Lens' s a
L.textFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSelFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTimeFieldStyle s a => Lens' s a
L.timeFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
inputBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTimeFieldStyle s a => Lens' s a
L.timeFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSelFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOnStyle s a => Lens' s a
L.toggleBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainBgActive BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOnStyle s a => Lens' s a
L.toggleBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
btnMainBorderFocus BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOffStyle s a => Lens' s a
L.toggleBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnBgActive BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOffStyle s a => Lens' s a
L.toggleBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Border
btnBorderFocus BaseThemeColors
themeMod

baseDisabled :: BaseThemeColors -> ThemeState
baseDisabled :: BaseThemeColors -> ThemeState
baseDisabled BaseThemeColors
themeMod = BaseThemeColors -> ThemeState
baseBasic BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnStyle s a => Lens' s a
L.btnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnTextDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnStyle s a => Lens' s a
L.btnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnBgDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnStyle s a => Lens' s a
L.btnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
btnBgDisabled BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnMainStyle s a => Lens' s a
L.btnMainStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainTextDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnMainStyle s a => Lens' s a
L.btnMainStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainBgDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasBtnMainStyle s a => Lens' s a
L.btnMainStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
btnMainBgDisabled BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasCheckboxStyle s a => Lens' s a
L.checkboxStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasCheckboxStyle s a => Lens' s a
L.checkboxStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputHlDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDateFieldStyle s a => Lens' s a
L.dateFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputBgDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDateFieldStyle s a => Lens' s a
L.dateFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputTextDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialStyle s a => Lens' s a
L.dialStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDialStyle s a => Lens' s a
L.dialStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSndColor s a => Lens' s a
L.sndColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSndDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownStyle s a => Lens' s a
L.dropdownStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputTextDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownStyle s a => Lens' s a
L.dropdownStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputBgDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasDropdownStyle s a => Lens' s a
L.dropdownStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
inputBgDisabled BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasExternalLinkStyle s a => Lens' s a
L.externalLinkStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
externalLinkDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasNumericFieldStyle s a => Lens' s a
L.numericFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputBgDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasNumericFieldStyle s a => Lens' s a
L.numericFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputTextDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOnStyle s a => Lens' s a
L.optionBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainTextDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOnStyle s a => Lens' s a
L.optionBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainBgDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOnStyle s a => Lens' s a
L.optionBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
btnMainBgDisabled BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOffStyle s a => Lens' s a
L.optionBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnTextDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOffStyle s a => Lens' s a
L.optionBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnBgDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasOptionBtnOffStyle s a => Lens' s a
L.optionBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
btnBgDisabled BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasRadioStyle s a => Lens' s a
L.radioStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasRadioStyle s a => Lens' s a
L.radioStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputHlDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSliderStyle s a => Lens' s a
L.sliderStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFgColor s a => Lens' s a
L.fgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputFgDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSliderStyle s a => Lens' s a
L.sliderStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHlColor s a => Lens' s a
L.hlColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputHlDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasSliderStyle s a => Lens' s a
L.sliderStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSndColor s a => Lens' s a
L.sndColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputSndDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTextAreaStyle s a => Lens' s a
L.textAreaStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputBgDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTextAreaStyle s a => Lens' s a
L.textAreaStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputTextDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTextFieldStyle s a => Lens' s a
L.textFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputBgDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTextFieldStyle s a => Lens' s a
L.textFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputTextDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTimeFieldStyle s a => Lens' s a
L.timeFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputBgDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasTimeFieldStyle s a => Lens' s a
L.timeFieldStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
inputTextDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOnStyle s a => Lens' s a
L.toggleBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainTextDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOnStyle s a => Lens' s a
L.toggleBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnMainBgDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOnStyle s a => Lens' s a
L.toggleBtnOnStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
btnMainBgDisabled BaseThemeColors
themeMod)
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOffStyle s a => Lens' s a
L.toggleBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def 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 (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnTextDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOffStyle s a => Lens' s a
L.toggleBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ BaseThemeColors -> Color
btnBgDisabled BaseThemeColors
themeMod
  forall a b. a -> (a -> b) -> b
& forall s a. HasToggleBtnOffStyle s a => Lens' s a
L.toggleBtnOffStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasBorder s a => Lens' s a
L.border forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall t. CmbBorder t => Double -> Color -> t
border Double
1 (BaseThemeColors -> Color
btnBgDisabled BaseThemeColors
themeMod)