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

Theme configuration types.
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE Strict #-}

module Monomer.Core.ThemeTypes where

import Control.Applicative ((<|>))
import Data.Default
import GHC.Generics

import qualified Data.Map.Strict as M

import Monomer.Common
import Monomer.Core.StyleTypes
import Monomer.Graphics.ColorTable
import Monomer.Graphics.Types

-- | Theme configuration for each state, plus clear/base color.
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
(Theme -> Theme -> Bool) -> (Theme -> Theme -> Bool) -> Eq Theme
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
(Int -> Theme -> ShowS)
-> (Theme -> String) -> ([Theme] -> ShowS) -> Show Theme
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. Theme -> Rep Theme x)
-> (forall x. Rep Theme x -> Theme) -> Generic Theme
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 :: Color
-> Color
-> Map String Color
-> ThemeState
-> ThemeState
-> ThemeState
-> ThemeState
-> ThemeState
-> ThemeState
-> Theme
Theme {
    _themeClearColor :: Color
_themeClearColor = Color
forall a. Default a => a
def,
    _themeSectionColor :: Color
_themeSectionColor = Color
forall a. Default a => a
def,
    _themeUserColorMap :: Map String Color
_themeUserColorMap = Map String Color
forall a. Default a => a
def,
    _themeBasic :: ThemeState
_themeBasic = ThemeState
forall a. Default a => a
def,
    _themeHover :: ThemeState
_themeHover = ThemeState
forall a. Default a => a
def,
    _themeFocus :: ThemeState
_themeFocus = ThemeState
forall a. Default a => a
def,
    _themeFocusHover :: ThemeState
_themeFocusHover = ThemeState
forall a. Default a => a
def,
    _themeActive :: ThemeState
_themeActive = ThemeState
forall a. Default a => a
def,
    _themeDisabled :: ThemeState
_themeDisabled = ThemeState
forall a. Default a => a
def
  }

-- | Default theme settings for each widget.
data ThemeState = ThemeState {
  ThemeState -> StyleState
_thsEmptyOverlayStyle :: StyleState,
  ThemeState -> StyleState
_thsBtnStyle :: StyleState,
  ThemeState -> StyleState
_thsBtnMainStyle :: 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
(ThemeState -> ThemeState -> Bool)
-> (ThemeState -> ThemeState -> Bool) -> Eq ThemeState
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
(Int -> ThemeState -> ShowS)
-> (ThemeState -> String)
-> ([ThemeState] -> ShowS)
-> Show ThemeState
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. ThemeState -> Rep ThemeState x)
-> (forall x. Rep ThemeState x -> ThemeState) -> Generic ThemeState
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 :: StyleState
-> StyleState
-> StyleState
-> StyleState
-> Double
-> StyleState
-> StyleState
-> Rational
-> Double
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> Double
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> Double
-> Bool
-> Bool
-> Color
-> Color
-> Double
-> Double
-> Double
-> Double
-> Rational
-> Double
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> Maybe Double
-> Double
-> Rational
-> Double
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> Map String StyleState
-> Map String Color
-> ThemeState
ThemeState {
    _thsEmptyOverlayStyle :: StyleState
_thsEmptyOverlayStyle = StyleState
forall a. Default a => a
def,
    _thsBtnStyle :: StyleState
_thsBtnStyle = StyleState
forall a. Default a => a
def,
    _thsBtnMainStyle :: StyleState
_thsBtnMainStyle = StyleState
forall a. Default a => a
def,
    _thsCheckboxStyle :: StyleState
_thsCheckboxStyle = StyleState
forall a. Default a => a
def,
    _thsCheckboxWidth :: Double
_thsCheckboxWidth = Double
20,
    _thsDateFieldStyle :: StyleState
_thsDateFieldStyle = StyleState
forall a. Default a => a
def,
    _thsDialStyle :: StyleState
_thsDialStyle = StyleState
forall a. Default a => a
def,
    _thsDialWheelRate :: Rational
_thsDialWheelRate = Rational
10,
    _thsDialWidth :: Double
_thsDialWidth = Double
50,
    _thsDialogFrameStyle :: StyleState
_thsDialogFrameStyle = StyleState
forall a. Default a => a
def,
    _thsDialogTitleStyle :: StyleState
_thsDialogTitleStyle = StyleState
forall a. Default a => a
def,
    _thsDialogCloseIconStyle :: StyleState
_thsDialogCloseIconStyle = StyleState
forall a. Default a => a
def,
    _thsDialogButtonsStyle :: StyleState
_thsDialogButtonsStyle = StyleState
forall a. Default a => a
def,
    _thsDialogMsgBodyStyle :: StyleState
_thsDialogMsgBodyStyle = StyleState
forall a. Default a => a
def,
    _thsDropdownMaxHeight :: Double
_thsDropdownMaxHeight = Double
150,
    _thsDropdownStyle :: StyleState
_thsDropdownStyle = StyleState
forall a. Default a => a
def,
    _thsDropdownListStyle :: StyleState
_thsDropdownListStyle = StyleState
forall a. Default a => a
def,
    _thsDropdownItemStyle :: StyleState
_thsDropdownItemStyle = StyleState
forall a. Default a => a
def,
    _thsDropdownItemSelectedStyle :: StyleState
_thsDropdownItemSelectedStyle = StyleState
forall a. Default a => a
def,
    _thsExternalLinkStyle :: StyleState
_thsExternalLinkStyle = StyleState
forall a. Default a => a
def,
    _thsLabelStyle :: StyleState
_thsLabelStyle = StyleState
forall a. Default a => a
def,
    _thsNumericFieldStyle :: StyleState
_thsNumericFieldStyle = StyleState
forall a. Default a => a
def,
    _thsOptionBtnOnStyle :: StyleState
_thsOptionBtnOnStyle = StyleState
forall a. Default a => a
def,
    _thsOptionBtnOffStyle :: StyleState
_thsOptionBtnOffStyle = StyleState
forall a. Default a => a
def,
    _thsRadioStyle :: StyleState
_thsRadioStyle = StyleState
forall a. Default a => a
def,
    _thsRadioWidth :: Double
_thsRadioWidth = Double
20,
    _thsScrollOverlay :: Bool
_thsScrollOverlay = Bool
False,
    _thsScrollFollowFocus :: Bool
_thsScrollFollowFocus = Bool
True,
    _thsScrollBarColor :: Color
_thsScrollBarColor = Color
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 = StyleState
forall a. Default a => a
def,
    _thsSelectListStyle :: StyleState
_thsSelectListStyle = StyleState
forall a. Default a => a
def,
    _thsSelectListItemStyle :: StyleState
_thsSelectListItemStyle = StyleState
forall a. Default a => a
def,
    _thsSelectListItemSelectedStyle :: StyleState
_thsSelectListItemSelectedStyle = StyleState
forall a. Default a => a
def,
    _thsSliderStyle :: StyleState
_thsSliderStyle = StyleState
forall a. Default a => a
def,
    _thsSliderRadius :: Maybe Double
_thsSliderRadius = Maybe Double
forall a. Maybe a
Nothing,
    _thsSliderThumbFactor :: Double
_thsSliderThumbFactor = Double
1.25,
    _thsSliderWheelRate :: Rational
_thsSliderWheelRate = Rational
10,
    _thsSliderWidth :: Double
_thsSliderWidth = Double
10,
    _thsTextAreaStyle :: StyleState
_thsTextAreaStyle = StyleState
forall a. Default a => a
def,
    _thsTextFieldStyle :: StyleState
_thsTextFieldStyle = StyleState
forall a. Default a => a
def,
    _thsTimeFieldStyle :: StyleState
_thsTimeFieldStyle = StyleState
forall a. Default a => a
def,
    _thsToggleBtnOnStyle :: StyleState
_thsToggleBtnOnStyle = StyleState
forall a. Default a => a
def,
    _thsToggleBtnOffStyle :: StyleState
_thsToggleBtnOffStyle = StyleState
forall a. Default a => a
def,
    _thsTooltipStyle :: StyleState
_thsTooltipStyle = StyleState
forall a. Default a => a
def,
    _thsUserStyleMap :: Map String StyleState
_thsUserStyleMap = Map String StyleState
forall k a. Map k a
M.empty,
    _thsUserColorMap :: Map String Color
_thsUserColorMap = Map String Color
forall k a. Map k a
M.empty
  }

instance Semigroup ThemeState where
  <> :: ThemeState -> ThemeState -> ThemeState
(<>) ThemeState
t1 ThemeState
t2 = ThemeState :: StyleState
-> StyleState
-> StyleState
-> StyleState
-> Double
-> StyleState
-> StyleState
-> Rational
-> Double
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> Double
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> Double
-> Bool
-> Bool
-> Color
-> Color
-> Double
-> Double
-> Double
-> Double
-> Rational
-> Double
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> Maybe Double
-> Double
-> Rational
-> Double
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> StyleState
-> Map String StyleState
-> Map String Color
-> ThemeState
ThemeState {
    _thsEmptyOverlayStyle :: StyleState
_thsEmptyOverlayStyle = ThemeState -> StyleState
_thsEmptyOverlayStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsEmptyOverlayStyle ThemeState
t2,
    _thsBtnStyle :: StyleState
_thsBtnStyle = ThemeState -> StyleState
_thsBtnStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsBtnStyle ThemeState
t2,
    _thsBtnMainStyle :: StyleState
_thsBtnMainStyle = ThemeState -> StyleState
_thsBtnMainStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsBtnMainStyle ThemeState
t2,
    _thsCheckboxStyle :: StyleState
_thsCheckboxStyle = ThemeState -> StyleState
_thsCheckboxStyle ThemeState
t1 StyleState -> StyleState -> StyleState
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 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDateFieldStyle ThemeState
t2,
    _thsDialStyle :: StyleState
_thsDialStyle = ThemeState -> StyleState
_thsDialStyle ThemeState
t1 StyleState -> StyleState -> StyleState
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 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDialogFrameStyle ThemeState
t2,
    _thsDialogTitleStyle :: StyleState
_thsDialogTitleStyle = ThemeState -> StyleState
_thsDialogTitleStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDialogTitleStyle ThemeState
t2,
    _thsDialogCloseIconStyle :: StyleState
_thsDialogCloseIconStyle = ThemeState -> StyleState
_thsDialogCloseIconStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDialogCloseIconStyle ThemeState
t2,
    _thsDialogMsgBodyStyle :: StyleState
_thsDialogMsgBodyStyle = ThemeState -> StyleState
_thsDialogMsgBodyStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDialogMsgBodyStyle ThemeState
t2,
    _thsDialogButtonsStyle :: StyleState
_thsDialogButtonsStyle = ThemeState -> StyleState
_thsDialogButtonsStyle ThemeState
t1 StyleState -> StyleState -> StyleState
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 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDropdownStyle ThemeState
t2,
    _thsDropdownListStyle :: StyleState
_thsDropdownListStyle = ThemeState -> StyleState
_thsDropdownListStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDropdownListStyle ThemeState
t2,
    _thsDropdownItemStyle :: StyleState
_thsDropdownItemStyle = ThemeState -> StyleState
_thsDropdownItemStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDropdownItemStyle ThemeState
t2,
    _thsDropdownItemSelectedStyle :: StyleState
_thsDropdownItemSelectedStyle = ThemeState -> StyleState
_thsDropdownItemSelectedStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsDropdownItemSelectedStyle ThemeState
t2,
    _thsExternalLinkStyle :: StyleState
_thsExternalLinkStyle = ThemeState -> StyleState
_thsExternalLinkStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsExternalLinkStyle ThemeState
t2,
    _thsLabelStyle :: StyleState
_thsLabelStyle = ThemeState -> StyleState
_thsLabelStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsLabelStyle ThemeState
t2,
    _thsNumericFieldStyle :: StyleState
_thsNumericFieldStyle = ThemeState -> StyleState
_thsNumericFieldStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsNumericFieldStyle ThemeState
t2,
    _thsOptionBtnOnStyle :: StyleState
_thsOptionBtnOnStyle = ThemeState -> StyleState
_thsOptionBtnOnStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsOptionBtnOnStyle ThemeState
t2,
    _thsOptionBtnOffStyle :: StyleState
_thsOptionBtnOffStyle = ThemeState -> StyleState
_thsOptionBtnOffStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsOptionBtnOffStyle ThemeState
t2,
    _thsRadioStyle :: StyleState
_thsRadioStyle = ThemeState -> StyleState
_thsRadioStyle ThemeState
t1 StyleState -> StyleState -> StyleState
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 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsSeparatorLineStyle ThemeState
t2,
    _thsSelectListStyle :: StyleState
_thsSelectListStyle = ThemeState -> StyleState
_thsSelectListStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsSelectListStyle ThemeState
t2,
    _thsSelectListItemStyle :: StyleState
_thsSelectListItemStyle = ThemeState -> StyleState
_thsSelectListItemStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsSelectListItemStyle ThemeState
t2,
    _thsSelectListItemSelectedStyle :: StyleState
_thsSelectListItemSelectedStyle = ThemeState -> StyleState
_thsSelectListItemSelectedStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsSelectListItemSelectedStyle ThemeState
t2,
    _thsSliderStyle :: StyleState
_thsSliderStyle = ThemeState -> StyleState
_thsSliderStyle ThemeState
t1 StyleState -> StyleState -> StyleState
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 Maybe Double -> Maybe Double -> Maybe Double
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 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsTextAreaStyle ThemeState
t2,
    _thsTextFieldStyle :: StyleState
_thsTextFieldStyle = ThemeState -> StyleState
_thsTextFieldStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsTextFieldStyle ThemeState
t2,
    _thsTimeFieldStyle :: StyleState
_thsTimeFieldStyle = ThemeState -> StyleState
_thsTimeFieldStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsTimeFieldStyle ThemeState
t2,
    _thsToggleBtnOnStyle :: StyleState
_thsToggleBtnOnStyle = ThemeState -> StyleState
_thsToggleBtnOnStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsToggleBtnOnStyle ThemeState
t2,
    _thsToggleBtnOffStyle :: StyleState
_thsToggleBtnOffStyle = ThemeState -> StyleState
_thsToggleBtnOffStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsToggleBtnOffStyle ThemeState
t2,
    _thsTooltipStyle :: StyleState
_thsTooltipStyle = ThemeState -> StyleState
_thsTooltipStyle ThemeState
t1 StyleState -> StyleState -> StyleState
forall a. Semigroup a => a -> a -> a
<> ThemeState -> StyleState
_thsTooltipStyle ThemeState
t2,
    _thsUserStyleMap :: Map String StyleState
_thsUserStyleMap = ThemeState -> Map String StyleState
_thsUserStyleMap ThemeState
t1 Map String StyleState
-> Map String StyleState -> Map String StyleState
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 Map String Color -> Map String Color -> Map String Color
forall a. Semigroup a => a -> a -> a
<> ThemeState -> Map String Color
_thsUserColorMap ThemeState
t2
  }