content: {-|
  Module      : Monomer.Widgets.Containers.ThemeSwitch
  Copyright   : (c) 2018 Francisco Vallarino
  License     : BSD-3-Clause (see the LICENSE file)
  Maintainer  : fjvallarino@gmail.com
  Stability   : experimental
  Portability : non-portable
  
  Switches to the provided theme for its child nodes.
  
  @
  theme = case activeTheme of
    DarkTheme -> darkTheme
    LightTheme -> lightTheme
  
  widgetTree = themeSwitch theme $ vstack [
      hstack [
        label "Select theme:",
        spacer,
        textDropdownS activeTheme [DarkTheme, LightTheme]
      ]
    ]
  @
  
  Note: this widget ignores style settings applied to itself. If you need to
  display borders or any other kind of style configuration, set it on the child
  node or wrap the themeSwitch widget in a "Monomer.Widgets.Containers.Box".
  -}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE StrictData #-}
  
  module Monomer.Widgets.Containers.ThemeSwitch (
    -- * Configuration
    ThemeSwitchCfg,
    themeClearBg,
    themeClearBg_,
    -- * Constructors
    themeSwitch,
    themeSwitch_
  ) where
  
  import Control.Applicative ((<|>))
  import Control.Lens ((&), (^.), (.~))
  import Data.Default
  
  import qualified Data.Sequence as Seq
  
  import Monomer.Widgets.Container
  
  import qualified Monomer.Lens as L
  
  {-|
  Configuration options for themeSwitch:
  
  - 'themeClearBg': indicates the clear color of the theme should be applied
    before rendering children. Defaults to False.
  -}
  newtype ThemeSwitchCfg = ThemeSwitchCfg {
    _tmcClearBg :: Maybe Bool
  } deriving (Eq, Show)
  
  
  instance Default ThemeSwitchCfg where
    def = ThemeSwitchCfg {
      _tmcClearBg = Nothing
    }
  
  instance Semigroup ThemeSwitchCfg where
    (<>) s1 s2 = ThemeSwitchCfg {
      _tmcClearBg = _tmcClearBg s2 <|> _tmcClearBg s1
    }
  
  instance Monoid ThemeSwitchCfg where
    mempty = def
  
  -- | Indicates the clear color should be applied before rendering children.
  themeClearBg :: ThemeSwitchCfg
  themeClearBg = themeClearBg_ True
  
  -- | Sets whether the clear color should be applied before rendering children.
  themeClearBg_ :: Bool -> ThemeSwitchCfg
  themeClearBg_ clear = def {
    _tmcClearBg = Just clear
  }
  
  data ThemeSwitchState = ThemeSwitchState {
    _tssPrevTheme :: Maybe Theme,
    _tssChanged :: Bool
  } deriving (Show)
  
  -- | Switches to a new theme starting from its child node.
  themeSwitch
    :: Theme           -- ^ The new theme.
    -> WidgetNode s e  -- ^ The child node.
    -> WidgetNode s e  -- ^ The created themeSwitch container.
  themeSwitch theme managed = themeSwitch_ theme def managed
  
  -- | Switches to a new theme starting from its child node. Accepts config.
  themeSwitch_
    :: Theme             -- ^ The new theme.
    -> [ThemeSwitchCfg]  -- ^ The config options.
    -> WidgetNode s e    -- ^ The child node.
    -> WidgetNode s e    -- ^ The created themeSwitch container.
  themeSwitch_ theme configs managed = makeNode widget managed where
    config = mconcat configs
    state = ThemeSwitchState Nothing False
    widget = makeThemeSwitch theme config state
  
  makeNode :: Widget s e -> WidgetNode s e -> WidgetNode s e
  makeNode widget managedWidget = defaultWidgetNode "themeSwitch" widget
    & L.info . L.focusable .~ False
    & L.children .~ Seq.singleton managedWidget
  
  makeThemeSwitch :: Theme -> ThemeSwitchCfg -> ThemeSwitchState -> Widget s e
  makeThemeSwitch theme config state = widget where
    widget = createContainer state def {
      containerUpdateCWenv = updateCWenv,
      containerGetCurrentStyle = getCurrentStyle,
      containerInit = init,
      containerMerge = merge
    }
  
    updateCWenv wenv cidx cnode node = newWenv where
      oldTheme = _tssPrevTheme state
      -- When called during merge, the state has not yet been updated
      themeChanged = _tssChanged state || Just theme /= oldTheme
      parentChanged = wenv ^. L.themeChanged
      newWenv = wenv
        & L.theme .~ theme
        & L.themeChanged .~ (themeChanged || parentChanged)
  
    getCurrentStyle wenv node = style where
      clearBg = _tmcClearBg config == Just True
      clearColor = theme ^. L.clearColor
      style
        | clearBg = bgColor clearColor
        | otherwise = def
  
    init wenv node = resultNode newNode where
      newState = ThemeSwitchState (Just theme) False
      newNode = node
        & L.widget .~ makeThemeSwitch theme config newState
  
    merge wenv node oldNode oldState = resultNode newNode where
      oldTheme = _tssPrevTheme oldState
      newState = ThemeSwitchState (Just theme) (Just theme /= oldTheme)
      newNode = node
        & L.widget .~ makeThemeSwitch theme config newState
  