content: {-|
  Module      : Monomer.Widgets.Containers.BoxSpec
  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 Box widget.
  -}
  {-# LANGUAGE FlexibleContexts #-}
  
  module Monomer.Widgets.Containers.BoxSpec (spec) where
  
  import Control.Lens ((&), (^.), (^?!), (.~), ix)
  import Data.Text (Text)
  import Data.Typeable (Typeable)
  import Test.Hspec
  
  import qualified Data.Sequence as Seq
  
  import Monomer.Core
  import Monomer.Core.Combinators
  import Monomer.Event
  import Monomer.Graphics
  import Monomer.TestEventUtil
  import Monomer.TestUtil
  import Monomer.Widgets.Containers.Box
  import Monomer.Widgets.Containers.Grid
  import Monomer.Widgets.Containers.ZStack
  import Monomer.Widgets.Singles.Button
  import Monomer.Widgets.Singles.Label
  
  import qualified Monomer.Lens as L
  
  data TestEvent
    = BtnClick Int
    | BoxOnEnter
    | BoxOnLeave
    | BoxOnPressed Button Int
    | BoxOnReleased Button Int
    | GotFocus Path
    | LostFocus Path
    deriving (Eq, Show)
  
  spec :: Spec
  spec = describe "Box" $ do
    mergeReq
    filterEvent
    handleEvent
    handleEventIgnoreEmpty
    handleEventSinkEmpty
    getSizeReq
    getSizeReqUpdater
    resize
  
  mergeReq :: Spec
  mergeReq = describe "mergeReq" $ do
    it "should return the new node, since a handler was not provided" $
      mergeWith box1 boxM ^. L.info . L.key `shouldBe` Just (WidgetKey "btnNew")
  
    it "should return the new node, since the handler returned merge is needed" $
      mergeWith box2 boxM ^. L.info . L.key `shouldBe` Just (WidgetKey "btnNew")
  
    it "should return the old node, since the handler returned merge is not needed" $
      mergeWith box3 boxM ^. L.info . L.key `shouldBe` Just (WidgetKey "btnOld")
  
    where
      wenv = mockWenv ()
      btnNew = button "Click" (BtnClick 0) `nodeKey` "btnNew"
      btnOld = button "Click" (BtnClick 0) `nodeKey` "btnOld"
      box1 = box btnNew
      box2 = box_ [mergeRequired (\_ _ _ -> True)] btnNew
      box3 = box_ [mergeRequired (\_ _ _ -> False)] btnNew
      boxM = box btnOld
      mergeWith newNode oldNode = result ^?! L.node . L.children . ix 0 where
        oldNode2 = nodeInit wenv oldNode
        result = widgetMerge (newNode ^. L.widget) wenv newNode oldNode2
  
  filterEvent :: Spec
  filterEvent = describe "filterEvent" $ do
    it "should click the first button, since the click event was directed to it" $
      evts False [evtClick point1] `shouldBe` Seq.singleton (BtnClick 1)
  
    it "should click the second button, since the click event's target was modified" $
      evts True [evtClick point1] `shouldBe` Seq.singleton (BtnClick 2)
  
    where
      wenv = mockWenv ()
      point1 = Point 320 200
      point2 = Point 320 400
  
      filterEvent wenv node target evt = Just (target & ix 2 .~ 1, evtClick point2)
  
      btnBox ignore = box_ (expandContent : [boxFilterEvent filterEvent | ignore]) $
        vgrid [
          button "Button 1" (BtnClick 1),
          button "Button 2" (BtnClick 2)
        ]
      evts ignore es = nodeHandleEventEvts wenv es $
        nodeInit wenv (btnBox ignore)
  
  handleEvent :: Spec
  handleEvent = describe "handleEvent" $ do
    it "should not generate an event if clicked outside" $
      evts [evtClick (Point 3000 3000)] `shouldBe` Seq.empty
  
    it "should generate an event if the button (centered) is clicked" $
      evts [evtClick (Point 320 240)] `shouldBe` Seq.singleton (BtnClick 0)
  
    it "should generate an event when the cursor enters the viewport" $
      evts [evtMove (Point 320 240)] `shouldBe` Seq.singleton BoxOnEnter
  
    it "should generate an event when the cursor leaves the viewport" $
      evts [evtMove (Point 320 240), evtMove (Point 3000 3000)] `shouldBe` Seq.fromList [BoxOnEnter, BoxOnLeave]
  
    it "should generate an event if the button is pressed in the child viewport" $
      evts [evtPress (Point 320 240)] `shouldBe` Seq.singleton (BoxOnPressed BtnLeft 1)
  
    it "should generate an event if the button is released in the child viewport" $
      evts [evtMove (Point 320 240), evtRelease (Point 320 240)] `shouldBe` Seq.fromList [BoxOnEnter, BoxOnReleased BtnLeft 1]
  
    it "should generate an event when focus is received" $
      evts [evtFocus] `shouldBe` Seq.singleton (GotFocus emptyPath)
  
    it "should generate an event when focus is lost" $
      evts [evtBlur] `shouldBe` Seq.singleton (LostFocus emptyPath)
  
    where
      wenv = mockWenv ()
      btnBox = box_ [onClick (BtnClick 0),
        onFocus GotFocus,
        onBlur LostFocus,
        onEnter BoxOnEnter,
        onLeave BoxOnLeave,
        onBtnPressed BoxOnPressed,
        onBtnReleased BoxOnReleased] (label "Test")
      boxNode = nodeInit wenv (btnBox `nodeFocusable` True)
      evts es = nodeHandleEventEvts wenv es boxNode
  
  handleEventIgnoreEmpty :: Spec
  handleEventIgnoreEmpty = describe "handleEventIgnoreEmpty" $ do
    it "should click the bottom layer, since nothing is handled on top" $
      clickIgnored (Point 200 15) `shouldBe` Seq.singleton (BtnClick 1)
  
    it "should click the top layer, since pointer is on the button" $
      clickIgnored (Point 320 240) `shouldBe` Seq.singleton (BtnClick 2)
  
    where
      wenv = mockWenv ()
      btn2 = button "Click 2" (BtnClick 2) `styleBasic` [height 10]
      ignoredNode = zstack_ [onlyTopActive_ False] [
          button "Click 1" (BtnClick 1),
          box_ [ignoreEmptyArea_ True] btn2
        ]
      clickIgnored p = nodeHandleEventEvts wenv [evtClick p] ignoredNode
  
  handleEventSinkEmpty :: Spec
  handleEventSinkEmpty = describe "handleEventSinkEmpty" $ do
    it "should do nothing, since event is not passed down" $
      clickSunk (Point 200 15) `shouldBe` Seq.empty
  
    it "should click the top layer, since pointer is on the button" $
      clickSunk (Point 320 240) `shouldBe` Seq.singleton (BtnClick 2)
  
    where
      wenv = mockWenv ()
      centeredBtn = button "Click 2" (BtnClick 2) `styleBasic` [height 10]
      sunkNode = zstack_ [onlyTopActive_ False] [
          button "Click 1" (BtnClick 1),
          box_ [ignoreEmptyArea_ False] centeredBtn
        ]
      clickSunk p = nodeHandleEventEvts wenv [evtClick p] sunkNode
  
  getSizeReq :: Spec
  getSizeReq = describe "getSizeReq" $ do
    it "should return width = Fixed 50" $
      sizeReqW `shouldBe` fixedSize 50
  
    it "should return height = Fixed 20" $
      sizeReqH `shouldBe` fixedSize 20
  
    where
      wenv = mockWenvEvtUnit ()
      boxNode = box (label "Label")
      (sizeReqW, sizeReqH) = nodeGetSizeReq wenv boxNode
  
  getSizeReqUpdater :: Spec
  getSizeReqUpdater = describe "getSizeReqUpdater" $ do
    it "should return width = Min 50 2" $
      sizeReqW `shouldBe` minSize 50 2
  
    it "should return height = Max 20" $
      sizeReqH `shouldBe` maxSize 20 3
  
    where
      wenv = mockWenvEvtUnit ()
      boxNode = box_ [sizeReqUpdater (fixedToMinW 2), sizeReqUpdater (fixedToMaxH 3)] (label "Label")
      (sizeReqW, sizeReqH) = nodeGetSizeReq wenv boxNode
  
  resize :: Spec
  resize = describe "resize" $ do
    resizeDefault
    resizeExpand
    resizeAlign
  
  resizeDefault :: Spec
  resizeDefault = describe "default" $ do
    it "should have the provided viewport size" $
      viewport `shouldBe` vp
  
    it "should have one child" $
      children `shouldSatisfy` (== 1) . Seq.length
  
    it "should have its children assigned a viewport" $
      cViewport `shouldBe` cvp
  
    where
      wenv = mockWenvEvtUnit ()
      vp  = Rect   0   0 640 480
      cvp = Rect 295 230  50  20
      boxNode = box (label "Label")
      newNode = nodeInit wenv boxNode
      children = newNode ^. L.children
      viewport = newNode ^. L.info . L.viewport
      cViewport = getChildVp wenv []
  
  resizeExpand :: Spec
  resizeExpand = describe "expand" $
    it "should have its children assigned a valid viewport" $
      cViewport `shouldBe` vp
  
    where
      wenv = mockWenvEvtUnit ()
      vp  = Rect   0   0 640 480
      cViewport = getChildVp wenv [expandContent]
  
  resizeAlign :: Spec
  resizeAlign = describe "align" $ do
    it "should align its child left" $
      childVpL `shouldBe` cvpl
  
    it "should align its child right" $
      childVpR `shouldBe` cvpr
  
    it "should align its child top" $
      childVpT `shouldBe` cvpt
  
    it "should align its child bottom" $
      childVpB `shouldBe` cvpb
  
    it "should align its child top-left" $
      childVpTL `shouldBe` cvplt
  
    it "should align its child bottom-right" $
      childVpBR `shouldBe` cvpbr
  
    where
      wenv = mockWenvEvtUnit ()
      cvpl  = Rect   0 230 50 20
      cvpr  = Rect 590 230 50 20
      cvpt  = Rect 295   0 50 20
      cvpb  = Rect 295 460 50 20
      cvplt = Rect   0   0 50 20
      cvpbr = Rect 590 460 50 20
      childVpL = getChildVp wenv [alignLeft]
      childVpR = getChildVp wenv [alignRight]
      childVpT = getChildVp wenv [alignTop]
      childVpB = getChildVp wenv [alignBottom]
      childVpTL = getChildVp wenv [alignTop, alignLeft]
      childVpBR = getChildVp wenv [alignBottom, alignRight]
  
  getChildVp :: (Eq s, WidgetModel s, WidgetEvent e) => WidgetEnv s e -> [BoxCfg s e] -> Rect
  getChildVp wenv cfgs = childLC ^. L.info . L.viewport where
    lblNode = label "Label"
    boxNodeLC = nodeInit wenv (box_ cfgs lblNode)
    childLC = Seq.index (boxNodeLC ^. L.children) 0
  