content: {-|
  Module      : Monomer.Widgets.Util.Style
  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 style related operations.
  -}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE Strict #-}
  
  module Monomer.Widgets.Util.Style (
    collectStyleField,
    collectStyleField_,
    currentTheme,
    currentTheme_,
    currentStyle,
    currentStyle_,
    focusedStyle,
    styleStateChanged,
    initNodeStyle,
    mergeBasicStyle,
    handleStyleChange,
    handleUserSizeReqChange,
    childOfFocusedStyle
  ) where
  
  import Control.Lens hiding ((<|), (|>))
  
  import Data.Default
  import Data.Maybe
  import Data.Sequence ((<|), (|>))
  
  import qualified Data.Sequence as Seq
  
  import Monomer.Core
  import Monomer.Event
  import Monomer.Helper
  import Monomer.Widgets.Util.Focus
  import Monomer.Widgets.Util.Hover
  import Monomer.Widgets.Util.Types
  import Monomer.Widgets.Util.Widget
  
  import qualified Monomer.Core.Lens as L
  import qualified Monomer.Event.Lens as L
  
  instance Default (CurrentStyleCfg s e) where
    def = CurrentStyleCfg {
      _ascIsHovered = isNodeHovered,
      _ascIsFocused = isNodeFocused,
      _ascIsActive = isNodeActive
    }
  
  -- | Extracts/copies the field of a style into an empty style.
  collectStyleField
    :: Lens' StyleState (Maybe t) -- ^ The field into the state.
    -> Style                      -- ^ The source style.
    -> Style                      -- ^ The new style.
  collectStyleField fieldS source = collectStyleField_ fieldS source def
  
  -- | Extracts/copies the field of a style into a provided style.
  collectStyleField_
    :: Lens' StyleState (Maybe t) -- ^ The field into the state.
    -> Style                      -- ^ The source style.
    -> Style                      -- ^ The target style.
    -> Style                      -- ^ The updated style.
  collectStyleField_ fieldS source target = style where
    setValue stateLens = result where
      sourceState = source ^. stateLens
      targetState = target ^. stateLens
      value = sourceState ^? _Just . fieldS . _Just
      setTarget val = targetState ^. non def
        & fieldS ?~ val
      resetTarget = targetState ^. non def
        & fieldS .~ Nothing
      result
        | isJust value = setTarget <$> value
        | isJust targetState = Just resetTarget
        | otherwise = Nothing
  
    basic = setValue L.basic
    hover = setValue L.hover
    focus = setValue L.focus
    focusHover = setValue L.focusHover
    active = setValue L.active
    disabled = setValue L.disabled
    style = Style basic hover focus focusHover active disabled
  
  -- | Returns the current style state for the given node.
  currentStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
  currentStyle wenv node = currentStyle_ def wenv node
  
  {-|
  Returns the current style state for the given node, using the provided functions
  to determine hover, focus and active status.
  -}
  currentStyle_
    :: CurrentStyleCfg s e -> WidgetEnv s e -> WidgetNode s e -> StyleState
  currentStyle_ config wenv node = fromMaybe def styleState where
    Style{..} = node ^. L.info . L.style
    mousePos = wenv ^. L.inputStatus . L.mousePos
    isEnabled = node ^. L.info . L.enabled
  
    isHover = _ascIsHovered config wenv node
    isFocus = _ascIsFocused config wenv node
    isActive = _ascIsActive config wenv node
  
    styleState
      | not isEnabled = _styleDisabled
      | isActive = _styleActive
      | isHover && isFocus = _styleFocusHover
      | isHover = _styleHover
      | isFocus = _styleFocus
      | otherwise = _styleBasic
  
  -- | Returns the correct focused style, depending if it's hovered or not.
  focusedStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
  focusedStyle wenv node = focusedStyle_ isNodeHovered wenv node
  
  {-|
  Returns the correct focused style, depending if it's hovered or not, using the
  provided function.
  -}
  focusedStyle_ :: IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> StyleState
  focusedStyle_ isHoveredFn wenv node = fromMaybe def styleState where
    Style{..} = node ^. L.info . L.style
    isHover = isHoveredFn wenv node
    styleState
      | isHover = _styleFocusHover
      | otherwise = _styleFocus
  
  -- | Returns the current theme for the node.
  currentTheme :: WidgetEnv s e -> WidgetNode s e -> ThemeState
  currentTheme wenv node = currentTheme_ isNodeHovered wenv node
  
  -- | Returns the current theme for the node.
  currentTheme_ :: IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> ThemeState
  currentTheme_ isHoveredFn wenv node = themeState where
    theme = _weTheme wenv
    mousePos = wenv ^. L.inputStatus . L.mousePos
    isEnabled = node ^. L.info . L.enabled
  
    isHover = isHoveredFn wenv node
    isFocus = isNodeFocused wenv node
    isActive = isNodeActive wenv node
  
    themeState
      | not isEnabled = _themeDisabled theme
      | isActive = _themeActive theme
      | isHover && isFocus = _themeFocusHover theme
      | isHover = _themeHover theme
      | isFocus = _themeFocus theme
      | otherwise = _themeBasic theme
  
  -- | Checks if hover or focus states changed between versions of the node.
  styleStateChanged :: WidgetEnv s e -> WidgetNode s e -> SystemEvent -> Bool
  styleStateChanged wenv node evt = hoverChanged || focusChanged where
    -- Hover
    hoverChanged = isOnEnter evt || isOnLeave evt
    -- Focus
    focusChanged = isOnFocus evt || isOnBlur evt
  
  {-|
  Initializes the node style states. Mainly, it uses basic as the base of all the
  other styles.
  -}
  initNodeStyle
    :: GetBaseStyle s e  -- ^ The function to get the base style.
    -> WidgetEnv s e     -- ^ The widget environment.
    -> WidgetNode s e    -- ^ The widget node.
    -> WidgetNode s e    -- ^ The updated widget node.
  initNodeStyle getBaseStyle wenv node = newNode where
    nodeStyle = mergeBasicStyle $ node ^. L.info . L.style
    baseStyle = mergeBasicStyle $ fromMaybe def (getBaseStyle wenv node)
    newNode = node
      & L.info . L.style .~ (baseStyle <> nodeStyle)
  
  -- | Uses the basic style state as the base for all the other style states.
  mergeBasicStyle :: Style -> Style
  mergeBasicStyle st = newStyle where
    focusHover = _styleHover st <> _styleFocus st <> _styleFocusHover st
    active = focusHover <> _styleActive st
    newStyle = Style {
      _styleBasic = _styleBasic st,
      _styleHover = _styleBasic st <> _styleHover st,
      _styleFocus = _styleBasic st <> _styleFocus st,
      _styleFocusHover = _styleBasic st <> focusHover,
      _styleActive = _styleBasic st <> active,
      _styleDisabled = _styleBasic st <> _styleDisabled st
    }
  
  {-|
  Checks for style changes between the old node and the provided result, in the
  context of an event. Generates requests for resize, render and cursor change as
  necessary.
  -}
  handleStyleChange
    :: WidgetEnv s e             -- ^ The widget environment.
    -> Path                      -- ^ The target of the event.
    -> StyleState                -- ^ The active style.
    -> Bool                      -- ^ Whether to check/update the cursor.
    -> WidgetNode s e            -- ^ The old node.
    -> SystemEvent               -- ^ The event.
    -> Maybe (WidgetResult s e)  -- ^ The result containing the new node.
    -> Maybe (WidgetResult s e)  -- ^ The updated result.
  handleStyleChange wenv target style doCursor node evt result = newResult where
    tmpResult = handleSizeChange wenv target evt node result
    newResult
      | doCursor = handleCursorChange wenv target evt style node tmpResult
      | otherwise = tmpResult
  
  {-|
  Checks if the user set size requests changed between the old and new versions of
  the node. Useful during merge to trigger a widget resize.
  -}
  handleUserSizeReqChange
    :: WidgetEnv s e
    -> WidgetNode s e
    -> WidgetResult s e
    -> WidgetResult s e
  handleUserSizeReqChange wenv oldNode result = newResult where
    newNode = result ^. L.node
    newWidgetId = newNode ^. L.info . L.widgetId
  
    (oldStyle, newStyle) = (currentStyle wenv oldNode, currentStyle wenv newNode)
    changedW = oldStyle ^. L.sizeReqW /= newStyle ^. L.sizeReqW
    changedH = oldStyle ^. L.sizeReqH /= newStyle ^. L.sizeReqH
    newResult
      | changedW || changedH = result
          & L.requests %~ (|> ResizeWidgets newWidgetId)
      | otherwise = result
  
  {-|
  Replacement of currentStyle for child widgets embedded in a focusable parent. It
  selects the correct style state according to the situation.
  
  Used, for example, in "Monomer.Widgets.Singles.Button" and
  "Monomer.Widgets.Singles.ExternalLink", which are focusable but have an embedded
  label. Since label is not focusable, that style would not be handled correctly.
  -}
  childOfFocusedStyle
    :: WidgetEnv s e   -- ^ The widget environment.
    -> WidgetNode s e  -- ^ The embedded child node.
    -> StyleState      -- ^ The currently active state.
  childOfFocusedStyle wenv cnode = newStyle where
    branch = wenv ^. L.findBranchByPath $ parentPath cnode
    pinfo = fromMaybe def (Seq.lookup (length branch - 1) branch)
    cstyle = cnode ^. L.info . L.style
    enabled = cnode ^. L.info . L.enabled
  
    activeC = isNodeActive wenv cnode
    activeP = isNodeInfoActive False wenv pinfo
  
    hoverC = isNodeHovered wenv cnode
    hoverP = isNodeInfoHovered wenv pinfo
    focusP = isNodeInfoFocused wenv pinfo
  
    newStyle
      | not enabled = fromMaybe def (_styleDisabled cstyle)
      | activeC || activeP = fromMaybe def (_styleActive cstyle)
      | (hoverC || hoverP) && focusP = fromMaybe def (_styleFocusHover cstyle)
      | hoverC || hoverP = fromMaybe def (_styleHover cstyle)
      | focusP = fromMaybe def (_styleFocus cstyle)
      | otherwise = currentStyle wenv cnode
  
  -- Helpers
  handleSizeChange
    :: WidgetEnv s e
    -> Path
    -> SystemEvent
    -> WidgetNode s e
    -> Maybe (WidgetResult s e)
    -> Maybe (WidgetResult s e)
  handleSizeChange wenv target evt oldNode result = newResult where
    baseResult = fromMaybe (resultNode oldNode) result
    newNode = baseResult ^. L.node
    widgetId = newNode ^. L.info . L.widgetId
    path = newNode ^. L.info . L.path
    -- Size
    oldSizeReqW = oldNode ^. L.info . L.sizeReqW
    oldSizeReqH = oldNode ^. L.info . L.sizeReqH
    newSizeReqW = newNode ^. L.info . L.sizeReqW
    newSizeReqH = newNode ^. L.info . L.sizeReqH
    sizeReqChanged = oldSizeReqW /= newSizeReqW || oldSizeReqH /= newSizeReqH
    -- Hover drag changed (if dragging, Enter/Leave is not sent)
    prevInVp = isPointInNodeVp newNode (wenv ^. L.inputStatus . L.mousePosPrev)
    currInVp = isPointInNodeVp newNode (wenv ^. L.inputStatus . L.mousePos)
    pressedPath = wenv ^. L.mainBtnPress ^? _Just . _1
    hoverDragChg = Just path == pressedPath && prevInVp /= currInVp
    -- Result
    renderReq = isOnEnter evt || isOnLeave evt || hoverDragChg
    resizeReq = [ ResizeWidgets widgetId | sizeReqChanged ]
    enterReq = [ RenderOnce | renderReq ]
    reqs = resizeReq ++ enterReq
    newResult
      | not (null reqs) = Just $ baseResult
        & L.requests <>~ Seq.fromList reqs
      | otherwise = result
  
  handleCursorChange
    :: WidgetEnv s e
    -> Path
    -> SystemEvent
    -> StyleState
    -> WidgetNode s e
    -> Maybe (WidgetResult s e)
    -> Maybe (WidgetResult s e)
  handleCursorChange wenv target evt style oldNode result = newResult where
    baseResult = fromMaybe (resultNode oldNode) result
    baseReqs = baseResult ^. L.requests
    node = baseResult ^. L.node
    -- Cursor
    widgetId = node ^. L.info . L.widgetId
    path = node ^. L.info . L.path
    isTarget = path == target
    hasCursor = isJust (style ^. L.cursorIcon)
    isPressed = isNodePressed wenv node
    (curPath, curIcon) = fromMaybe def (wenv ^. L.cursor)
    isParent = seqStartsWith path curPath && path /= curPath
    newIcon = fromMaybe CursorArrow (style ^. L.cursorIcon)
  
    setCursor = hasCursor
      && isCursorEvt evt
      && not isParent
      && curIcon /= newIcon
    resetCursor = isTarget
      && not hasCursor
      && isCursorEvt evt
      && not isPressed
      && curPath == path
    -- Result
    newResult
      | setCursor = Just $ baseResult
        & L.requests .~ SetCursorIcon widgetId newIcon <| baseReqs
      | resetCursor = Just $ baseResult
        & L.requests .~ baseReqs |> ResetCursorIcon widgetId
      | otherwise = result
  
  isCursorEvt :: SystemEvent -> Bool
  isCursorEvt Enter{} = True
  isCursorEvt Click{} = True
  isCursorEvt ButtonAction{} = True
  isCursorEvt Move{} = True
  isCursorEvt _ = False
  