Theme.hs

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

Helper functions for loading theme values.
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Strict #-}

module Monomer.Widgets.Util.Theme where

import Control.Lens (Lens', (&), (^.), (^?), (.~), (?~), (<>~), at, non)
import Data.Default
import Data.Maybe

import Monomer.Core.StyleTypes
import Monomer.Core.ThemeTypes
import Monomer.Core.WidgetTypes

import qualified Monomer.Core.Lens as L

-- | Updates a the field of style with the field value from the active theme.
collectThemeField_
  :: WidgetEnv s e               -- ^ The widget environment (to get the theme).
  -> Lens' StyleState (Maybe t)  -- ^ The target field of the style.
  -> Lens' ThemeState (Maybe t)  -- ^ The source field of the theme.
  -> Style                       -- ^ The target style.
  -> Style                       -- ^ The updated style.
collectThemeField_ wenv fieldStyle fieldTheme target = style where
  basic = Just $ target ^. L.basic . non def
    & fieldStyle .~ wenv ^. L.theme . L.basic . fieldTheme
  hover = Just $ target ^. L.hover . non def
    & fieldStyle .~ wenv ^. L.theme . L.hover . fieldTheme
  focus = Just $ target ^. L.focus . non def
    & fieldStyle .~ wenv ^. L.theme . L.focus . fieldTheme
  focusHover = Just $ target ^. L.focusHover . non def
    & fieldStyle .~ wenv ^. L.theme . L.focusHover . fieldTheme
  active = Just $ target ^. L.active . non def
    & fieldStyle .~ wenv ^. L.theme . L.active . fieldTheme
  disabled = Just $ target ^. L.disabled . non def
    & fieldStyle .~ wenv ^. L.theme . L.disabled . fieldTheme
  style = Style basic hover focus focusHover active disabled

-- | Collects all the style states from a given field in the active theme.
collectTheme
  :: WidgetEnv s e               -- ^ The widget environment (to get the theme).
  -> Lens' ThemeState StyleState -- ^ The field into the theme
  -> Style                       -- ^ The collected style.
collectTheme wenv fieldT = style where
  basic = Just $ wenv ^. L.theme . L.basic . fieldT
  hover = Just $ wenv ^. L.theme . L.hover . fieldT
  focus = Just $ wenv ^. L.theme . L.focus . fieldT
  focusHover = Just $ wenv ^. L.theme . L.focusHover . fieldT
  active = Just $ wenv ^. L.theme . L.active . fieldT
  disabled = Just $ wenv ^. L.theme . L.disabled . fieldT
  style = Style basic hover focus focusHover active disabled

-- | Collects all the style states from a given entry in the map of user styles
--   in the active theme.
collectUserTheme
  :: WidgetEnv s e  -- ^ The widget environment (to get the theme).
  -> String         -- ^ The key into the user map.
  -> Style          -- ^ The collected style.
collectUserTheme wenv name = style where
  basic = wenv ^. L.theme . L.basic . L.userStyleMap . at name
  hover = wenv ^. L.theme . L.hover . L.userStyleMap . at name
  focus = wenv ^. L.theme . L.focus . L.userStyleMap . at name
  focusHover = wenv ^. L.theme . L.focusHover . L.userStyleMap . at name
  active = wenv ^. L.theme . L.active . L.userStyleMap . at name
  disabled = wenv ^. L.theme . L.disabled . L.userStyleMap . at name
  style = Style basic hover focus focusHover active disabled

{-|
Sets the given value, overwriting the previous one, for each of the states of a
theme.

Useful for customizing a base theme.

@
theme = darkTheme
  & setThemeValue L.sliderRadius (Just 10)
  & setThemeValue L.sliderWidth 10
@
-}
setThemeValue
  :: Lens' ThemeState a
  -> a
  -> Theme
  -> Theme
setThemeValue field value theme = newTheme where
  newTheme = theme
    & L.basic . field .~ value
    & L.hover . field .~ value
    & L.focus . field .~ value
    & L.focusHover . field .~ value
    & L.active . field .~ value
    & L.disabled . field .~ value

{-|
Sets the given style options, overwriting the previous style, for each of the
states of a theme.

Useful for customizing a base theme.

@
theme = darkTheme
  & setThemeStyle L.dropdownStyle [padding 6, paddingV 6]
@

Note: In most cases 'mergeThemeStyle' is a better choice, since it keeps all the
other style settings intact.
-}
setThemeStyle
  :: Lens' ThemeState StyleState
  -> [StyleState]
  -> Theme
  -> Theme
setThemeStyle field styles theme = newTheme where
  !value = mconcat styles
  newTheme = theme
    & L.basic . field .~ value
    & L.hover . field .~ value
    & L.focus . field .~ value
    & L.focusHover . field .~ value
    & L.active . field .~ value
    & L.disabled . field .~ value

{-|
Merges the given style options with the existing style, for each of the states
of a theme.

Useful for customizing a base theme.

@
theme = darkTheme
  & mergeThemeStyle L.dropdownStyle [padding 6, paddingV 6]
@
-}
mergeThemeStyle
  :: Lens' ThemeState StyleState
  -> [StyleState]
  -> Theme
  -> Theme
mergeThemeStyle field styles theme = newTheme where
  !value = mconcat styles
  newTheme = theme
    & L.basic . field <>~ value
    & L.hover . field <>~ value
    & L.focus . field <>~ value
    & L.focusHover . field <>~ value
    & L.active . field <>~ value
    & L.disabled . field <>~ value