content: {-|
  Module      : Monomer.Widgets.Util.StyleSpec
  Copyright   : (c) 2018 Francisco Vallarino
  License     : BSD-3-Clause (see the LICENSE file)
  Maintainer  : fjvallarino@gmail.com
  Stability   : experimental
  Portability : non-portable
  
  Unit tests for Style handling.
  -}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  
  module Monomer.Widgets.Util.StyleSpec (spec) where
  
  import Control.Lens ((&), (^.), (^?), (^?!), (.~), (?~), _Just, at, ix, non)
  import Data.Default
  import Data.Sequence (Seq(..))
  import Data.Text (Text)
  import Test.Hspec
  
  import qualified Data.Sequence as Seq
  
  import Monomer.Core
  import Monomer.Core.Combinators
  import Monomer.Event
  import Monomer.Graphics
  import Monomer.Graphics.ColorTable
  import Monomer.Widgets.Singles.Label
  import Monomer.Widgets.Util.Style
  import Monomer.TestEventUtil
  import Monomer.TestUtil
  
  import qualified Monomer.Lens as L
  
  spec :: Spec
  spec = describe "Style" $ do
    testCurrentStyle
    testHandleSizeChange
  
  testCurrentStyle :: Spec
  testCurrentStyle = describe "currentStyle" $ do
    it "should return basic style" $
      currentStyle wenvBasic nodeNormal ^. L.bgColor `shouldBe` Just white
  
    it "should return hover style" $
      currentStyle wenvHover nodeNormal ^. L.bgColor `shouldBe` Just green
  
    it "should return hover style" $
      currentStyle wenvFocus nodeNormal ^. L.bgColor `shouldBe` Just blue
  
    it "should return focusHover style" $
      currentStyle wenvHoverFocus nodeNormal ^. L.bgColor `shouldBe` Just orange
  
    it "should return active style" $
      currentStyle wenvActive nodeNormal ^. L.bgColor `shouldBe` Just pink
  
    it "should return disabled style" $ do
      currentStyle wenvBasic nodeDisabled ^. L.bgColor `shouldBe` Just gray
      currentStyle wenvHover nodeDisabled ^. L.bgColor `shouldBe` Just gray
      currentStyle wenvFocus nodeDisabled ^. L.bgColor `shouldBe` Just gray
      currentStyle wenvHoverFocus nodeDisabled ^. L.bgColor `shouldBe` Just gray
  
    where
      wenvBasic = mockWenv () & L.inputStatus . L.mousePos .~ Point 0 0
      wenvFocus = wenvBasic & L.focusedPath .~ Seq.fromList [0]
      wenvHover = mockWenv () & L.inputStatus . L.mousePos .~ Point 200 200
      wenvHoverFocus = wenvHover
        & L.inputStatus . L.mousePos .~ Point 200 200
        & L.focusedPath .~ Seq.fromList [0]
      wenvActive = mockWenv ()
        & L.inputStatus . L.mousePos .~ Point 200 200
        & L.mainBtnPress ?~ (Seq.fromList [0], Point 200 200)
      nodeNormal = createNode True
      nodeDisabled = createNode False
  
  testHandleSizeChange :: Spec
  testHandleSizeChange = describe "handleSizeChange" $ do
    it "should request Resize widgets if sizeReq changed" $ do
      resHover ^? _Just . L.requests `shouldSatisfy` (==3) . maybeLength
      resHover ^? _Just . L.requests . ix 0 `shouldSatisfy` isMSetCursorIcon
      resHover ^? _Just . L.requests . ix 1 `shouldSatisfy` isMResizeWidgets
      resHover ^? _Just . L.requests . ix 2 `shouldSatisfy` isMRenderOnce
  
    it "should not request Resize widgets if sizeReq has not changed" $
      resFocus ^? _Just . L.requests `shouldSatisfy` (==0) . maybeLength
  
    where
      wenv = mockWenv ()
      style = createStyle
        & L.hover ?~ padding 10
        & L.hover . non def . L.cursorIcon ?~ CursorHand
      hoverStyle = style ^?! L.hover . _Just
      focusStyle = style ^?! L.focus . _Just
      baseNode = createNode True
        & L.info . L.style .~ style
      node = nodeInit wenv baseNode
      modNode = node & L.info . L.sizeReqW .~ fixedSize 100
      res1 = Just $ WidgetResult modNode Empty
      res2 = Just $ WidgetResult node Empty
      point = Point 200 200
      path = Seq.fromList [0]
      wenvHover = mockWenv () & L.inputStatus . L.mousePos .~ point
      wenvFocus = mockWenv () & L.focusedPath .~ path
      evEnter = Enter point
      resHover = handleStyleChange wenvHover path hoverStyle True node evEnter res1
      resFocus = handleStyleChange wenvFocus path focusStyle True node evtFocus res2
  
  isMResizeWidgets :: Maybe (WidgetRequest s e) -> Bool
  isMResizeWidgets (Just ResizeWidgets{}) = True
  isMResizeWidgets _ = False
  
  isMRenderOnce :: Maybe (WidgetRequest s e) -> Bool
  isMRenderOnce (Just RenderOnce{}) = True
  isMRenderOnce _ = False
  
  isMSetCursorIcon :: Maybe (WidgetRequest s e) -> Bool
  isMSetCursorIcon (Just SetCursorIcon{}) = True
  isMSetCursorIcon _ = False
  
  maybeLength :: Maybe (Seq a) -> Int
  maybeLength Nothing = 0
  maybeLength (Just s) = Seq.length s
  
  createStyle :: Style
  createStyle = newStyle where
    basic = createStyleState 10 white
    hover = createStyleState 20 green
    focus = createStyleState 30 blue
    focusHover = createStyleState 30 orange
    active = createStyleState 30 pink
    disabled = createStyleState 40 gray
    newStyle = Style basic hover focus focusHover active disabled
  
  createStyleState :: Double -> Color -> Maybe StyleState
  createStyleState size col = Just newState where
    newState = textSize size <> bgColor col
  
  createNode :: Bool -> WidgetNode s e
  createNode enabled = newNode where
    viewport = Rect 100 100 200 200
    newNode = label "Test"
      & L.info . L.path .~ Seq.fromList [0]
      & L.info . L.viewport .~ viewport
      & L.info . L.style .~ createStyle
      & L.info . L.visible .~ True
      & L.info . L.enabled .~ enabled
      & L.info . L.focusable .~ True
  