{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StrictData #-}
module Monomer.Widgets.Containers.ThemeSwitch (
ThemeSwitchCfg,
themeClearBg,
themeClearBg_,
themeSwitch,
themeSwitch_
) where
import Control.Applicative ((<|>))
import Control.Monad (when)
import Control.Lens ((&), (^.), (.~), (%~), at)
import Data.Default
import Data.Maybe
import qualified Data.Sequence as Seq
import Monomer.Widgets.Container
import qualified Monomer.Lens as L
newtype ThemeSwitchCfg = ThemeSwitchCfg {
ThemeSwitchCfg -> Maybe Bool
_tmcClearBg :: Maybe Bool
} deriving (ThemeSwitchCfg -> ThemeSwitchCfg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThemeSwitchCfg -> ThemeSwitchCfg -> Bool
$c/= :: ThemeSwitchCfg -> ThemeSwitchCfg -> Bool
== :: ThemeSwitchCfg -> ThemeSwitchCfg -> Bool
$c== :: ThemeSwitchCfg -> ThemeSwitchCfg -> Bool
Eq, Int -> ThemeSwitchCfg -> ShowS
[ThemeSwitchCfg] -> ShowS
ThemeSwitchCfg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThemeSwitchCfg] -> ShowS
$cshowList :: [ThemeSwitchCfg] -> ShowS
show :: ThemeSwitchCfg -> String
$cshow :: ThemeSwitchCfg -> String
showsPrec :: Int -> ThemeSwitchCfg -> ShowS
$cshowsPrec :: Int -> ThemeSwitchCfg -> ShowS
Show)
instance Default ThemeSwitchCfg where
def :: ThemeSwitchCfg
def = ThemeSwitchCfg {
_tmcClearBg :: Maybe Bool
_tmcClearBg = forall a. Maybe a
Nothing
}
instance Semigroup ThemeSwitchCfg where
<> :: ThemeSwitchCfg -> ThemeSwitchCfg -> ThemeSwitchCfg
(<>) ThemeSwitchCfg
s1 ThemeSwitchCfg
s2 = ThemeSwitchCfg {
_tmcClearBg :: Maybe Bool
_tmcClearBg = ThemeSwitchCfg -> Maybe Bool
_tmcClearBg ThemeSwitchCfg
s2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ThemeSwitchCfg -> Maybe Bool
_tmcClearBg ThemeSwitchCfg
s1
}
instance Monoid ThemeSwitchCfg where
mempty :: ThemeSwitchCfg
mempty = forall a. Default a => a
def
themeClearBg :: ThemeSwitchCfg
themeClearBg :: ThemeSwitchCfg
themeClearBg = Bool -> ThemeSwitchCfg
themeClearBg_ Bool
True
themeClearBg_ :: Bool -> ThemeSwitchCfg
themeClearBg_ :: Bool -> ThemeSwitchCfg
themeClearBg_ Bool
clear = forall a. Default a => a
def {
_tmcClearBg :: Maybe Bool
_tmcClearBg = forall a. a -> Maybe a
Just Bool
clear
}
data ThemeSwitchState = ThemeSwitchState {
ThemeSwitchState -> Maybe Theme
_tssPrevTheme :: Maybe Theme,
ThemeSwitchState -> Bool
_tssChanged :: Bool
}
themeSwitch
:: Theme
-> WidgetNode s e
-> WidgetNode s e
themeSwitch :: forall s e. Theme -> WidgetNode s e -> WidgetNode s e
themeSwitch Theme
theme WidgetNode s e
managed = forall s e.
Theme -> [ThemeSwitchCfg] -> WidgetNode s e -> WidgetNode s e
themeSwitch_ Theme
theme forall a. Default a => a
def WidgetNode s e
managed
themeSwitch_
:: Theme
-> [ThemeSwitchCfg]
-> WidgetNode s e
-> WidgetNode s e
themeSwitch_ :: forall s e.
Theme -> [ThemeSwitchCfg] -> WidgetNode s e -> WidgetNode s e
themeSwitch_ Theme
theme [ThemeSwitchCfg]
configs WidgetNode s e
managed = forall s e. Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode forall {s} {e}. Widget s e
widget WidgetNode s e
managed where
config :: ThemeSwitchCfg
config = forall a. Monoid a => [a] -> a
mconcat [ThemeSwitchCfg]
configs
state :: ThemeSwitchState
state = Maybe Theme -> Bool -> ThemeSwitchState
ThemeSwitchState forall a. Maybe a
Nothing Bool
False
widget :: Widget s e
widget = forall s e.
Theme -> ThemeSwitchCfg -> ThemeSwitchState -> Widget s e
makeThemeSwitch Theme
theme ThemeSwitchCfg
config ThemeSwitchState
state
makeNode :: Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode :: forall s e. Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode Widget s e
widget WidgetNode s e
managedWidget = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"themeSwitch" Widget s e
widget
forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFocusable s a => Lens' s a
L.focusable 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. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Seq a
Seq.singleton WidgetNode s e
managedWidget
makeThemeSwitch :: Theme -> ThemeSwitchCfg -> ThemeSwitchState -> Widget s e
makeThemeSwitch :: forall s e.
Theme -> ThemeSwitchCfg -> ThemeSwitchState -> Widget s e
makeThemeSwitch Theme
theme ThemeSwitchCfg
config ThemeSwitchState
state = forall {s} {e}. Widget s e
widget where
widget :: Widget s e
widget = forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer ThemeSwitchState
state forall a. Default a => a
def {
containerUpdateCWenv :: ContainerUpdateCWenvHandler s e
containerUpdateCWenv = forall {p} {p} {p} {p}.
(HasTheme p Theme, HasThemeChanged p Bool) =>
p -> p -> p -> p -> p
updateCWenv,
containerGetCurrentStyle :: ContainerGetCurrentStyle s e
containerGetCurrentStyle = forall {t} {p} {p}. (CmbBgColor t, Default t) => p -> p -> t
getCurrentStyle,
containerInit :: ContainerInitHandler s e
containerInit = forall {p} {s} {e}. p -> WidgetNode s e -> WidgetResult s e
init,
containerMerge :: ContainerMergeHandler s e ThemeSwitchState
containerMerge = forall {p} {s} {e} {p}.
p -> WidgetNode s e -> p -> ThemeSwitchState -> WidgetResult s e
merge
}
updateCWenv :: p -> p -> p -> p -> p
updateCWenv p
wenv p
cidx p
cnode p
node = p
newWenv where
oldTheme :: Maybe Theme
oldTheme = ThemeSwitchState -> Maybe Theme
_tssPrevTheme ThemeSwitchState
state
themeChanged :: Bool
themeChanged = ThemeSwitchState -> Bool
_tssChanged ThemeSwitchState
state Bool -> Bool -> Bool
|| forall a. a -> Maybe a
Just Theme
theme forall a. Eq a => a -> a -> Bool
/= Maybe Theme
oldTheme
parentChanged :: Bool
parentChanged = p
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasThemeChanged s a => Lens' s a
L.themeChanged
newWenv :: p
newWenv = p
wenv
forall a b. a -> (a -> b) -> b
& forall s a. HasTheme s a => Lens' s a
L.theme forall s t a b. ASetter s t a b -> b -> s -> t
.~ Theme
theme
forall a b. a -> (a -> b) -> b
& forall s a. HasThemeChanged s a => Lens' s a
L.themeChanged forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Bool
themeChanged Bool -> Bool -> Bool
|| Bool
parentChanged)
getCurrentStyle :: p -> p -> t
getCurrentStyle p
wenv p
node = t
style where
clearBg :: Bool
clearBg = ThemeSwitchCfg -> Maybe Bool
_tmcClearBg ThemeSwitchCfg
config forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
clearColor :: Color
clearColor = Theme
theme forall s a. s -> Getting a s a -> a
^. forall s a. HasClearColor s a => Lens' s a
L.clearColor
style :: t
style
| Bool
clearBg = forall t. CmbBgColor t => Color -> t
bgColor Color
clearColor
| Bool
otherwise = forall a. Default a => a
def
init :: p -> WidgetNode s e -> WidgetResult s e
init p
wenv WidgetNode s e
node = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
newState :: ThemeSwitchState
newState = Maybe Theme -> Bool -> ThemeSwitchState
ThemeSwitchState (forall a. a -> Maybe a
Just Theme
theme) Bool
False
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e.
Theme -> ThemeSwitchCfg -> ThemeSwitchState -> Widget s e
makeThemeSwitch Theme
theme ThemeSwitchCfg
config ThemeSwitchState
newState
merge :: p -> WidgetNode s e -> p -> ThemeSwitchState -> WidgetResult s e
merge p
wenv WidgetNode s e
node p
oldNode ThemeSwitchState
oldState = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
oldTheme :: Maybe Theme
oldTheme = ThemeSwitchState -> Maybe Theme
_tssPrevTheme ThemeSwitchState
oldState
newState :: ThemeSwitchState
newState = Maybe Theme -> Bool -> ThemeSwitchState
ThemeSwitchState (forall a. a -> Maybe a
Just Theme
theme) (forall a. a -> Maybe a
Just Theme
theme forall a. Eq a => a -> a -> Bool
/= Maybe Theme
oldTheme)
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e.
Theme -> ThemeSwitchCfg -> ThemeSwitchState -> Widget s e
makeThemeSwitch Theme
theme ThemeSwitchCfg
config ThemeSwitchState
newState