{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
module Monomer.Core.ThemeTypes where
import Control.Applicative ((<|>))
import Data.Default
import GHC.Generics
import qualified Data.Map.Strict as M
import Monomer.Core.StyleTypes
import Monomer.Graphics.ColorTable
import Monomer.Graphics.Types
import Monomer.Graphics.Util
data Theme = Theme {
Theme -> Color
_themeClearColor :: Color,
Theme -> Color
_themeSectionColor :: Color,
Theme -> Map String Color
_themeUserColorMap :: M.Map String Color,
Theme -> ThemeState
_themeBasic :: ThemeState,
Theme -> ThemeState
_themeHover :: ThemeState,
Theme -> ThemeState
_themeFocus :: ThemeState,
Theme -> ThemeState
_themeFocusHover :: ThemeState,
Theme -> ThemeState
_themeActive :: ThemeState,
Theme -> ThemeState
_themeDisabled :: ThemeState
} deriving (Theme -> Theme -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Theme -> Theme -> Bool
$c/= :: Theme -> Theme -> Bool
== :: Theme -> Theme -> Bool
$c== :: Theme -> Theme -> Bool
Eq, Int -> Theme -> ShowS
[Theme] -> ShowS
Theme -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Theme] -> ShowS
$cshowList :: [Theme] -> ShowS
show :: Theme -> String
$cshow :: Theme -> String
showsPrec :: Int -> Theme -> ShowS
$cshowsPrec :: Int -> Theme -> ShowS
Show, forall x. Rep Theme x -> Theme
forall x. Theme -> Rep Theme x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Theme x -> Theme
$cfrom :: forall x. Theme -> Rep Theme x
Generic)
instance Default Theme where
def :: Theme
def = Theme {
_themeClearColor :: Color
_themeClearColor = forall a. Default a => a
def,
_themeSectionColor :: Color
_themeSectionColor = forall a. Default a => a
def,
_themeUserColorMap :: Map String Color
_themeUserColorMap = forall a. Default a => a
def,
_themeBasic :: ThemeState
_themeBasic = forall a. Default a => a
def,
_themeHover :: ThemeState
_themeHover = forall a. Default a => a
def,
_themeFocus :: ThemeState
_themeFocus = forall a. Default a => a
def,
_themeFocusHover :: ThemeState
_themeFocusHover = forall a. Default a => a
def,
_themeActive :: ThemeState
_themeActive = forall a. Default a => a
def,
_themeDisabled :: ThemeState
_themeDisabled = forall a. Default a => a
def
}
data ThemeState = ThemeState {
ThemeState -> StyleState
_thsEmptyOverlayStyle :: StyleState,
ThemeState -> Color
_thsShadowColor :: Color,
ThemeState -> AlignH
_thsShadowAlignH :: AlignH,
ThemeState -> AlignV
_thsShadowAlignV :: AlignV,
ThemeState -> StyleState
_thsBtnStyle :: StyleState,
ThemeState -> StyleState
_thsBtnMainStyle :: StyleState,
:: StyleState,
ThemeState -> StyleState
_thsCheckboxStyle :: StyleState,
ThemeState -> Double
_thsCheckboxWidth :: Double,
ThemeState -> StyleState
_thsDateFieldStyle :: StyleState,
ThemeState -> StyleState
_thsDialStyle :: StyleState,
ThemeState -> Rational
_thsDialWheelRate :: Rational,
ThemeState -> Double
_thsDialWidth :: Double,
ThemeState -> StyleState
_thsDialogFrameStyle :: StyleState,
ThemeState -> StyleState
_thsDialogTitleStyle :: StyleState,
ThemeState -> StyleState
_thsDialogCloseIconStyle :: StyleState,
ThemeState -> StyleState
_thsDialogButtonsStyle :: StyleState,
ThemeState -> StyleState
_thsDialogMsgBodyStyle :: StyleState,
ThemeState -> Double
_thsDropdownMaxHeight :: Double,
ThemeState -> StyleState
_thsDropdownStyle :: StyleState,
ThemeState -> StyleState
_thsDropdownListStyle :: StyleState,
ThemeState -> StyleState
_thsDropdownItemStyle :: StyleState,
ThemeState -> StyleState
_thsDropdownItemSelectedStyle :: StyleState,
ThemeState -> StyleState
_thsExternalLinkStyle :: StyleState,
ThemeState -> StyleState
_thsLabelStyle :: StyleState,
ThemeState -> StyleState
_thsNumericFieldStyle :: StyleState,
ThemeState -> StyleState
_thsOptionBtnOnStyle :: StyleState,
ThemeState -> StyleState
_thsOptionBtnOffStyle :: StyleState,
ThemeState -> StyleState
_thsRadioStyle :: StyleState,
ThemeState -> Double
_thsRadioWidth :: Double,
ThemeState -> Bool
_thsScrollOverlay :: Bool,
ThemeState -> Bool
_thsScrollFollowFocus :: Bool,
ThemeState -> Color
_thsScrollBarColor :: Color,
ThemeState -> Color
_thsScrollThumbColor :: Color,
ThemeState -> Double
_thsScrollBarWidth :: Double,
ThemeState -> Double
_thsScrollThumbWidth :: Double,
ThemeState -> Double
_thsScrollThumbMinSize :: Double,
ThemeState -> Double
_thsScrollThumbRadius :: Double,
ThemeState -> Rational
_thsScrollWheelRate :: Rational,
ThemeState -> Double
_thsSeparatorLineWidth :: Double,
ThemeState -> StyleState
_thsSeparatorLineStyle :: StyleState,
ThemeState -> StyleState
_thsSelectListStyle :: StyleState,
ThemeState -> StyleState
_thsSelectListItemStyle :: StyleState,
ThemeState -> StyleState
_thsSelectListItemSelectedStyle :: StyleState,
ThemeState -> StyleState
_thsSliderStyle :: StyleState,
ThemeState -> Maybe Double
_thsSliderRadius :: Maybe Double,
ThemeState -> Double
_thsSliderThumbFactor :: Double,
ThemeState -> Rational
_thsSliderWheelRate :: Rational,
ThemeState -> Double
_thsSliderWidth :: Double,
ThemeState -> StyleState
_thsTextAreaStyle :: StyleState,
ThemeState -> StyleState
_thsTextFieldStyle :: StyleState,
ThemeState -> StyleState
_thsTimeFieldStyle :: StyleState,
ThemeState -> StyleState
_thsToggleBtnOnStyle :: StyleState,
ThemeState -> StyleState
_thsToggleBtnOffStyle :: StyleState,
ThemeState -> StyleState
_thsTooltipStyle :: StyleState,
ThemeState -> Map String StyleState
_thsUserStyleMap :: M.Map String StyleState,
ThemeState -> Map String Color
_thsUserColorMap :: M.Map String Color
} deriving (ThemeState -> ThemeState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThemeState -> ThemeState -> Bool
$c/= :: ThemeState -> ThemeState -> Bool
== :: ThemeState -> ThemeState -> Bool
$c== :: ThemeState -> ThemeState -> Bool
Eq, Int -> ThemeState -> ShowS
[ThemeState] -> ShowS
ThemeState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThemeState] -> ShowS
$cshowList :: [ThemeState] -> ShowS
show :: ThemeState -> String
$cshow :: ThemeState -> String
showsPrec :: Int -> ThemeState -> ShowS
$cshowsPrec :: Int -> ThemeState -> ShowS
Show, forall x. Rep ThemeState x -> ThemeState
forall x. ThemeState -> Rep ThemeState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ThemeState x -> ThemeState
$cfrom :: forall x. ThemeState -> Rep ThemeState x
Generic)
instance Default ThemeState where
def :: ThemeState
def = ThemeState {
_thsEmptyOverlayStyle :: StyleState
_thsEmptyOverlayStyle = forall a. Default a => a
def,
_thsShadowColor :: Color
_thsShadowColor = Color
darkGray { _colorA :: Double
_colorA = Double
0.2 },
_thsShadowAlignH :: AlignH
_thsShadowAlignH = AlignH
ACenter,
_thsShadowAlignV :: AlignV
_thsShadowAlignV = AlignV
ABottom,
_thsBtnStyle :: StyleState
_thsBtnStyle = forall a. Default a => a
def,
_thsBtnMainStyle :: StyleState
_thsBtnMainStyle = forall a. Default a => a
def,
_thsColorPopupStyle :: StyleState
_thsColorPopupStyle = forall a. Default a => a
def,
_thsCheckboxStyle :: StyleState
_thsCheckboxStyle = forall a. Default a => a
def,
_thsCheckboxWidth :: Double
_thsCheckboxWidth = Double
20,
_thsDateFieldStyle :: StyleState
_thsDateFieldStyle = forall a. Default a => a
def,
_thsDialStyle :: StyleState
_thsDialStyle = forall a. Default a => a
def,
_thsDialWheelRate :: Rational
_thsDialWheelRate = Rational
10,
_thsDialWidth :: Double
_thsDialWidth = Double
50,
_thsDialogFrameStyle :: StyleState
_thsDialogFrameStyle = forall a. Default a => a
def,
_thsDialogTitleStyle :: StyleState
_thsDialogTitleStyle = forall a. Default a => a
def,
_thsDialogCloseIconStyle :: StyleState
_thsDialogCloseIconStyle = forall a. Default a => a
def,
_thsDialogButtonsStyle :: StyleState
_thsDialogButtonsStyle = forall a. Default a => a
def,
_thsDialogMsgBodyStyle :: StyleState
_thsDialogMsgBodyStyle = forall a. Default a => a
def,
_thsDropdownMaxHeight :: Double
_thsDropdownMaxHeight = Double
150,
_thsDropdownStyle :: StyleState
_thsDropdownStyle = forall a. Default a => a
def,
_thsDropdownListStyle :: StyleState
_thsDropdownListStyle = forall a. Default a => a
def,
_thsDropdownItemStyle :: StyleState
_thsDropdownItemStyle = forall a. Default a => a
def,
_thsDropdownItemSelectedStyle :: StyleState
_thsDropdownItemSelectedStyle = forall a. Default a => a
def,
_thsExternalLinkStyle :: StyleState
_thsExternalLinkStyle = forall a. Default a => a
def,
_thsLabelStyle :: StyleState
_thsLabelStyle = forall a. Default a => a
def,
_thsNumericFieldStyle :: StyleState
_thsNumericFieldStyle = forall a. Default a => a
def,
_thsOptionBtnOnStyle :: StyleState
_thsOptionBtnOnStyle = forall a. Default a => a
def,
_thsOptionBtnOffStyle :: StyleState
_thsOptionBtnOffStyle = forall a. Default a => a
def,
_thsRadioStyle :: StyleState
_thsRadioStyle = forall a. Default a => a
def,
_thsRadioWidth :: Double
_thsRadioWidth = Double
20,
_thsScrollOverlay :: Bool
_thsScrollOverlay = Bool
False,
_thsScrollFollowFocus :: Bool
_thsScrollFollowFocus = Bool
True,
_thsScrollBarColor :: Color
_thsScrollBarColor = forall a. Default a => a
def,
_thsScrollThumbColor :: Color
_thsScrollThumbColor = Color
darkGray,
_thsScrollBarWidth :: Double
_thsScrollBarWidth = Double
10,
_thsScrollThumbWidth :: Double
_thsScrollThumbWidth = Double
8,
_thsScrollThumbMinSize :: Double
_thsScrollThumbMinSize = Double
25,
_thsScrollThumbRadius :: Double
_thsScrollThumbRadius = Double
0,
_thsScrollWheelRate :: Rational
_thsScrollWheelRate = Rational
10,
_thsSeparatorLineWidth :: Double
_thsSeparatorLineWidth = Double
1,
_thsSeparatorLineStyle :: StyleState
_thsSeparatorLineStyle = forall a. Default a => a
def,
_thsSelectListStyle :: StyleState
_thsSelectListStyle = forall a. Default a => a
def,
_thsSelectListItemStyle :: StyleState
_thsSelectListItemStyle = forall a. Default a => a
def,
_thsSelectListItemSelectedStyle :: StyleState
_thsSelectListItemSelectedStyle = forall a. Default a => a
def,
_thsSliderStyle :: StyleState
_thsSliderStyle = forall a. Default a => a
def,
_thsSliderRadius :: Maybe Double
_thsSliderRadius = forall a. Maybe a
Nothing,
_thsSliderThumbFactor :: Double
_thsSliderThumbFactor = Double
1.25,
_thsSliderWheelRate :: Rational
_thsSliderWheelRate = Rational
10,
_thsSliderWidth :: Double
_thsSliderWidth = Double
10,
_thsTextAreaStyle :: StyleState
_thsTextAreaStyle = forall a. Default a => a
def,
_thsTextFieldStyle :: StyleState
_thsTextFieldStyle = forall a. Default a => a
def,
_thsTimeFieldStyle :: StyleState
_thsTimeFieldStyle = forall a. Default a => a
def,
_thsToggleBtnOnStyle :: StyleState
_thsToggleBtnOnStyle = forall a. Default a => a
def,
_thsToggleBtnOffStyle :: StyleState
_thsToggleBtnOffStyle = forall a. Default a => a
def,
_thsTooltipStyle :: StyleState
_thsTooltipStyle = forall a. Default a => a
def,
_thsUserStyleMap :: Map String StyleState
_thsUserStyleMap = forall k a. Map k a
M.empty,
_thsUserColorMap :: Map String Color
_thsUserColorMap = forall k a. Map k a
M.empty
}
instance Semigroup ThemeState where
<> :: ThemeState -> ThemeState -> ThemeState
(<>) ThemeState
t1 ThemeState
t2 = ThemeState {
_thsEmptyOverlayStyle :: StyleState
_thsEmptyOverlayStyle = ThemeState -> StyleState
_thsEmptyOverlayStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsEmptyOverlayStyle ThemeState
t2,
_thsShadowColor :: Color
_thsShadowColor = ThemeState -> Color
_thsShadowColor ThemeState
t2,
_thsShadowAlignH :: AlignH
_thsShadowAlignH = ThemeState -> AlignH
_thsShadowAlignH ThemeState
t2,
_thsShadowAlignV :: AlignV
_thsShadowAlignV = ThemeState -> AlignV
_thsShadowAlignV ThemeState
t2,
_thsBtnStyle :: StyleState
_thsBtnStyle = ThemeState -> StyleState
_thsBtnStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsBtnStyle ThemeState
t2,
_thsBtnMainStyle :: StyleState
_thsBtnMainStyle = ThemeState -> StyleState
_thsBtnMainStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsBtnMainStyle ThemeState
t2,
_thsColorPopupStyle :: StyleState
_thsColorPopupStyle = ThemeState -> StyleState
_thsColorPopupStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsColorPopupStyle ThemeState
t2,
_thsCheckboxStyle :: StyleState
_thsCheckboxStyle = ThemeState -> StyleState
_thsCheckboxStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsCheckboxStyle ThemeState
t2,
_thsCheckboxWidth :: Double
_thsCheckboxWidth = ThemeState -> Double
_thsCheckboxWidth ThemeState
t2,
_thsDateFieldStyle :: StyleState
_thsDateFieldStyle = ThemeState -> StyleState
_thsDateFieldStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDateFieldStyle ThemeState
t2,
_thsDialStyle :: StyleState
_thsDialStyle = ThemeState -> StyleState
_thsDialStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDialStyle ThemeState
t2,
_thsDialWheelRate :: Rational
_thsDialWheelRate = ThemeState -> Rational
_thsDialWheelRate ThemeState
t2,
_thsDialWidth :: Double
_thsDialWidth = ThemeState -> Double
_thsDialWidth ThemeState
t2,
_thsDialogFrameStyle :: StyleState
_thsDialogFrameStyle = ThemeState -> StyleState
_thsDialogFrameStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDialogFrameStyle ThemeState
t2,
_thsDialogTitleStyle :: StyleState
_thsDialogTitleStyle = ThemeState -> StyleState
_thsDialogTitleStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDialogTitleStyle ThemeState
t2,
_thsDialogCloseIconStyle :: StyleState
_thsDialogCloseIconStyle = ThemeState -> StyleState
_thsDialogCloseIconStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDialogCloseIconStyle ThemeState
t2,
_thsDialogMsgBodyStyle :: StyleState
_thsDialogMsgBodyStyle = ThemeState -> StyleState
_thsDialogMsgBodyStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDialogMsgBodyStyle ThemeState
t2,
_thsDialogButtonsStyle :: StyleState
_thsDialogButtonsStyle = ThemeState -> StyleState
_thsDialogButtonsStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDialogButtonsStyle ThemeState
t2,
_thsDropdownMaxHeight :: Double
_thsDropdownMaxHeight = ThemeState -> Double
_thsDropdownMaxHeight ThemeState
t2,
_thsDropdownStyle :: StyleState
_thsDropdownStyle = ThemeState -> StyleState
_thsDropdownStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDropdownStyle ThemeState
t2,
_thsDropdownListStyle :: StyleState
_thsDropdownListStyle = ThemeState -> StyleState
_thsDropdownListStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDropdownListStyle ThemeState
t2,
_thsDropdownItemStyle :: StyleState
_thsDropdownItemStyle = ThemeState -> StyleState
_thsDropdownItemStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDropdownItemStyle ThemeState
t2,
_thsDropdownItemSelectedStyle :: StyleState
_thsDropdownItemSelectedStyle = ThemeState -> StyleState
_thsDropdownItemSelectedStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDropdownItemSelectedStyle ThemeState
t2,
_thsExternalLinkStyle :: StyleState
_thsExternalLinkStyle = ThemeState -> StyleState
_thsExternalLinkStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsExternalLinkStyle ThemeState
t2,
_thsLabelStyle :: StyleState
_thsLabelStyle = ThemeState -> StyleState
_thsLabelStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsLabelStyle ThemeState
t2,
_thsNumericFieldStyle :: StyleState
_thsNumericFieldStyle = ThemeState -> StyleState
_thsNumericFieldStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsNumericFieldStyle ThemeState
t2,
_thsOptionBtnOnStyle :: StyleState
_thsOptionBtnOnStyle = ThemeState -> StyleState
_thsOptionBtnOnStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsOptionBtnOnStyle ThemeState
t2,
_thsOptionBtnOffStyle :: StyleState
_thsOptionBtnOffStyle = ThemeState -> StyleState
_thsOptionBtnOffStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsOptionBtnOffStyle ThemeState
t2,
_thsRadioStyle :: StyleState
_thsRadioStyle = ThemeState -> StyleState
_thsRadioStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsRadioStyle ThemeState
t2,
_thsRadioWidth :: Double
_thsRadioWidth = ThemeState -> Double
_thsRadioWidth ThemeState
t2,
_thsScrollOverlay :: Bool
_thsScrollOverlay = ThemeState -> Bool
_thsScrollOverlay ThemeState
t2,
_thsScrollFollowFocus :: Bool
_thsScrollFollowFocus = ThemeState -> Bool
_thsScrollFollowFocus ThemeState
t2,
_thsScrollBarColor :: Color
_thsScrollBarColor = ThemeState -> Color
_thsScrollBarColor ThemeState
t2,
_thsScrollThumbColor :: Color
_thsScrollThumbColor = ThemeState -> Color
_thsScrollThumbColor ThemeState
t2,
_thsScrollBarWidth :: Double
_thsScrollBarWidth = ThemeState -> Double
_thsScrollBarWidth ThemeState
t2,
_thsScrollThumbWidth :: Double
_thsScrollThumbWidth = ThemeState -> Double
_thsScrollThumbWidth ThemeState
t2,
_thsScrollThumbMinSize :: Double
_thsScrollThumbMinSize = ThemeState -> Double
_thsScrollThumbMinSize ThemeState
t2,
_thsScrollThumbRadius :: Double
_thsScrollThumbRadius = ThemeState -> Double
_thsScrollThumbRadius ThemeState
t2,
_thsScrollWheelRate :: Rational
_thsScrollWheelRate = ThemeState -> Rational
_thsScrollWheelRate ThemeState
t2,
_thsSeparatorLineWidth :: Double
_thsSeparatorLineWidth = ThemeState -> Double
_thsSeparatorLineWidth ThemeState
t2,
_thsSeparatorLineStyle :: StyleState
_thsSeparatorLineStyle = ThemeState -> StyleState
_thsSeparatorLineStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsSeparatorLineStyle ThemeState
t2,
_thsSelectListStyle :: StyleState
_thsSelectListStyle = ThemeState -> StyleState
_thsSelectListStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsSelectListStyle ThemeState
t2,
_thsSelectListItemStyle :: StyleState
_thsSelectListItemStyle = ThemeState -> StyleState
_thsSelectListItemStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsSelectListItemStyle ThemeState
t2,
_thsSelectListItemSelectedStyle :: StyleState
_thsSelectListItemSelectedStyle = ThemeState -> StyleState
_thsSelectListItemSelectedStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsSelectListItemSelectedStyle ThemeState
t2,
_thsSliderStyle :: StyleState
_thsSliderStyle = ThemeState -> StyleState
_thsSliderStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsSliderStyle ThemeState
t2,
_thsSliderThumbFactor :: Double
_thsSliderThumbFactor = ThemeState -> Double
_thsSliderThumbFactor ThemeState
t2,
_thsSliderWheelRate :: Rational
_thsSliderWheelRate = ThemeState -> Rational
_thsSliderWheelRate ThemeState
t2,
_thsSliderWidth :: Double
_thsSliderWidth = ThemeState -> Double
_thsSliderWidth ThemeState
t2,
_thsSliderRadius :: Maybe Double
_thsSliderRadius = ThemeState -> Maybe Double
_thsSliderRadius ThemeState
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ThemeState -> Maybe Double
_thsSliderRadius ThemeState
t1,
_thsTextAreaStyle :: StyleState
_thsTextAreaStyle = ThemeState -> StyleState
_thsTextAreaStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsTextAreaStyle ThemeState
t2,
_thsTextFieldStyle :: StyleState
_thsTextFieldStyle = ThemeState -> StyleState
_thsTextFieldStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsTextFieldStyle ThemeState
t2,
_thsTimeFieldStyle :: StyleState
_thsTimeFieldStyle = ThemeState -> StyleState
_thsTimeFieldStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsTimeFieldStyle ThemeState
t2,
_thsToggleBtnOnStyle :: StyleState
_thsToggleBtnOnStyle = ThemeState -> StyleState
_thsToggleBtnOnStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsToggleBtnOnStyle ThemeState
t2,
_thsToggleBtnOffStyle :: StyleState
_thsToggleBtnOffStyle = ThemeState -> StyleState
_thsToggleBtnOffStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsToggleBtnOffStyle ThemeState
t2,
_thsTooltipStyle :: StyleState
_thsTooltipStyle = ThemeState -> StyleState
_thsTooltipStyle ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsTooltipStyle ThemeState
t2,
_thsUserStyleMap :: Map String StyleState
_thsUserStyleMap = ThemeState -> Map String StyleState
_thsUserStyleMap ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> Map String StyleState
_thsUserStyleMap ThemeState
t2,
_thsUserColorMap :: Map String Color
_thsUserColorMap = ThemeState -> Map String Color
_thsUserColorMap ThemeState
t1 forall a. Semigroup a => a -> a -> a
<> ThemeState -> Map String Color
_thsUserColorMap ThemeState
t2
}