content: {-|
  Module      : Monomer.Widgets.Containers.ZStackSpec
  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 ZStack widget.
  -}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE FunctionalDependencies #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TemplateHaskell #-}
  
  module Monomer.Widgets.Containers.ZStackSpec (spec) where
  
  import Control.Lens ((&), (^.), (.~))
  import Control.Lens.TH (abbreviatedFields, makeLensesWith)
  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.TestEventUtil
  import Monomer.TestUtil
  import Monomer.Widgets.Composite
  import Monomer.Widgets.Containers.Confirm
  import Monomer.Widgets.Containers.Stack
  import Monomer.Widgets.Containers.ZStack
  import Monomer.Widgets.Singles.Button
  import Monomer.Widgets.Singles.Label
  import Monomer.Widgets.Singles.TextField
  
  import qualified Monomer.Lens as L
  
  newtype BtnEvent
    = BtnClick Int
    deriving (Eq, Show)
  
  data TestModel = TestModel {
    _tmTextValue1 :: Text,
    _tmTextValue2 :: Text
  } deriving (Eq, Show)
  
  makeLensesWith abbreviatedFields ''TestModel
  
  spec :: Spec
  spec = describe "ZStack" $ do
    handleEvent
    getSizeReq
    resize
  
  handleEvent :: Spec
  handleEvent = describe "handleEvent" $ do
    handleEventFirstVisible
    handleEventAllLayersActive
    handleEventFocusTop
    handleEventFocusAll
    handleEventFocusChange
    handleEventFocusKeep
  
  handleEventFirstVisible :: Spec
  handleEventFirstVisible = describe "handleEventFirstVisible" $ do
    it "should not generate an event if clicked outside" $
      clickEvts (Point 3000 3000) `shouldBe` Seq.empty
  
    it "should click the second layer, since top is not visible" $
      clickEvts (Point 100 100) `shouldBe` Seq.singleton (BtnClick 2)
  
    where
      wenv = mockWenv ()
      zstackNode = zstack [
          button "Click 1" (BtnClick 1),
          button "Click 2" (BtnClick 2),
          button "Click 3" (BtnClick 3) `nodeVisible` False
        ]
      clickEvts p = nodeHandleEventEvts wenv [evtClick p] zstackNode
  
  handleEventAllLayersActive :: Spec
  handleEventAllLayersActive = describe "handleEventAllLayersActive" $ do
    it "should not generate an event if clicked outside" $
      clickEvts (Point 3000 3000) `shouldBe` Seq.empty
  
    it "should click the first layer, since top is not visible and second does not have widgets in that location" $
      clickEvts (Point 200 15) `shouldBe` Seq.singleton (BtnClick 1)
  
    where
      wenv = mockWenv ()
      zstackNode = zstack_ [onlyTopActive_ False] [
          button "Click 1" (BtnClick 1),
          vstack [
            button "Click 2" (BtnClick 2) `styleBasic` [height 10]
          ],
          button "Click 3" (BtnClick 3) `nodeVisible` False
        ]
      clickEvts p = nodeHandleEventEvts wenv [evtClick p] zstackNode
  
  handleEventFocusTop :: Spec
  handleEventFocusTop = describe "handleEventFocusTop" $
    it "should not attempt to set focus on lower layers" $ do
      let steps = [evtK keyTab, evtK keyTab, evtT "abc"]
      model steps ^. textValue1 `shouldBe` ""
      model steps ^. textValue2 `shouldBe` "abc"
  
    where
      wenv = mockWenvEvtUnit (TestModel "" "")
      zstackNode = zstack [
          textField textValue1,
          textField textValue2
        ]
      model es = nodeHandleEventModel wenv es zstackNode
  
  handleEventFocusAll :: Spec
  handleEventFocusAll = describe "handleEventFocusAll" $
    it "should set focus on second layer, since it's enabled" $ do
      let steps = [evtK keyTab, evtT "abc"]
      model steps ^. textValue1 `shouldBe` "abc"
      model steps ^. textValue2 `shouldBe` ""
  
    where
      wenv = mockWenvEvtUnit (TestModel "" "")
      zstackNode = zstack_ [onlyTopActive_ False] [
          textField textValue1,
          textField textValue2
        ]
      model es = nodeHandleEventModel wenv es zstackNode
  
  handleEventFocusChange :: Spec
  handleEventFocusChange = describe "handleEventFocusChange" $
    it "should restore focus when switching between layers" $ do
      let steps = [ evtK keyTab, evtK keyReturn, evtK keyTab, evtK keyReturn, evtK keyReturn, evtK keyReturn ]
      evts steps `shouldBe` Seq.fromList [BtnClick 2, BtnClick 4, BtnClick 2, BtnClick 4]
  
    where
      wenv = mockWenv 10
      handleEvent
        :: WidgetEnv Int BtnEvent
        -> WidgetNode Int BtnEvent
        -> Int
        -> BtnEvent
        -> [EventResponse Int BtnEvent Int BtnEvent]
      handleEvent wenv _ model (BtnClick idx) = [Report (BtnClick idx), Model idx]
      buildUI wenv model = zstack [
          hstack [
            button "3" (BtnClick 3),
            button "4" (BtnClick 4)
          ],
          hstack [
            button "1" (BtnClick 1),
            button "2" (BtnClick 2)
          ] `nodeVisible` (model > 2)
        ]
      cmpNode = composite "main" id buildUI handleEvent
      evts es = nodeHandleEventEvts wenv es cmpNode
  
  handleEventFocusKeep :: Spec
  handleEventFocusKeep = describe "handleEventFocusKeep" $
    it "should not restore focus when switching between layers if a focus change request is detected" $ do
      let steps = [ evtK keyTab, evtK keyReturn, evtK keyTab, evtK keyReturn, evtK keyReturn, evtK keyReturn ]
      evts steps `shouldBe` Seq.fromList [BtnClick 2, BtnClick 4, BtnClick 2, BtnClick 3]
  
    where
      wenv = mockWenv 10
      handleEvent
        :: WidgetEnv Int BtnEvent
        -> WidgetNode Int BtnEvent
        -> Int
        -> BtnEvent
        -> [EventResponse Int BtnEvent Int BtnEvent]
      handleEvent wenv _ model (BtnClick idx) = [Report (BtnClick idx), Model idx]
      buildUI wenv model = zstack [
          hstack [
            confirmMsg "Message" (BtnClick 3) (BtnClick 4)
          ] `nodeVisible` (model <= 2),
          hstack [
            button "1" (BtnClick 1),
            button "2" (BtnClick 2)
          ] `nodeVisible` (model > 2)
        ]
      cmpNode = composite "main" id buildUI handleEvent
      evts es = nodeHandleEventEvts wenv es cmpNode
  
  getSizeReq :: Spec
  getSizeReq = describe "getSizeReq" $ do
    getSizeReqEmpty
    getSizeReqItems
    getSizeReqItemsFixed
  
  getSizeReqEmpty :: Spec
  getSizeReqEmpty = describe "empty" $ do
    it "should return width = Fixed 0" $
      sizeReqW `shouldBe` fixedSize 0
  
    it "should return height = Fixed 0" $
      sizeReqH `shouldBe` fixedSize 0
  
    where
      wenv = mockWenv ()
      zstackNode = zstack []
      (sizeReqW, sizeReqH) = nodeGetSizeReq wenv zstackNode
  
  getSizeReqItems :: Spec
  getSizeReqItems = describe "several items, horizontal" $ do
    it "should return width = Fixed 130" $
      sizeReqW `shouldBe` fixedSize 130
  
    it "should return height = Fixed 60" $
      sizeReqH `shouldBe` fixedSize 60
  
    where
      wenv = mockWenv ()
      zstackNode = zstack [
          vstack [
            label "Label a1"
          ],
          vstack [
            label "Long label b1",
            label "Long label b2"
          ],
          vstack [
            label "Label c1",
            label "Label c2",
            label "Label c3"
          ]
        ]
      (sizeReqW, sizeReqH) = nodeGetSizeReq wenv zstackNode
  
  getSizeReqItemsFixed :: Spec
  getSizeReqItemsFixed = describe "several items, horizontal" $ do
    it "should return width = Fixed 300" $
      sizeReqW `shouldBe` fixedSize 300
  
    it "should return height = Fixed 40" $
      sizeReqH `shouldBe` fixedSize 40
  
    where
      wenv = mockWenv ()
      zstackNode = zstack [
          vstack [
            label "Label a1",
            label "Label a2"
          ],
          vstack [
            label "Long b1",
            label "Long b2"
          ] `styleBasic` [width 300]
        ]
      (sizeReqW, sizeReqH) = nodeGetSizeReq wenv zstackNode
  
  resize :: Spec
  resize = describe "resize" $ do
    resizeEmpty
    resizeItems
  
  resizeEmpty :: Spec
  resizeEmpty = describe "empty" $ do
    it "should have the provided viewport size" $
      viewport `shouldBe` vp
  
    it "should not have children" $
      children `shouldSatisfy` Seq.null
  
    where
      wenv = mockWenv ()
      vp = Rect 0 0 640 480
      zstackNode = zstack []
      newNode = nodeInit wenv zstackNode
      viewport = newNode ^. L.info . L.viewport
      children = newNode ^. L.children
  
  resizeItems :: Spec
  resizeItems = describe "several items, horizontal" $ do
    it "should have the provided viewport size" $
      viewport `shouldBe` vp
  
    it "should assign the same viewport size to each children" $
      childrenRa `shouldBe` Seq.fromList [vp, vp, vp]
  
    where
      wenv = mockWenv ()
      vp   = Rect 0 0 640 480
      zstackNode = zstack [
          label "Label 1",
          label "Label Number Two",
          label "Label 3"
        ]
      newNode = nodeInit wenv zstackNode
      viewport = newNode ^. L.info . L.viewport
      childrenRa = (^. L.info . L.viewport) <$> newNode ^. L.children
  