GridSpec.hs

{-|
Module      : Monomer.Widgets.Containers.GridSpec
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 Grid widget.
-}
{-# LANGUAGE FlexibleContexts #-}

module Monomer.Widgets.Containers.GridSpec (spec) where

import Control.Lens ((&), (^.), (.~))
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.TestUtil
import Monomer.Widgets.Containers.Grid
import Monomer.Widgets.Singles.Label
import Monomer.Widgets.Singles.Spacer

import qualified Monomer.Lens as L

spec :: Spec
spec = describe "Grid" $ do
  getSizeReq
  resize

getSizeReq :: Spec
getSizeReq = describe "getSizeReq" $ do
  getSizeReqEmpty
  getSizeReqItemsH
  getSizeReqItemsV
  getSizeReqMixedH
  getSizeReqMixedV
  getSizeReqUpdater
  getSizeReqChildSpacing

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 ()
    gridNode = vgrid []
    (sizeReqW, sizeReqH) = nodeGetSizeReq wenv gridNode

getSizeReqItemsH :: Spec
getSizeReqItemsH = describe "several items, horizontal" $ do
  it "should return width = Fixed 240 (largest width * 3)" $
    sizeReqW `shouldBe` fixedSize 240

  it "should return height = Fixed 20" $
    sizeReqH `shouldBe` fixedSize 20

  where
    wenv = mockWenv ()
    gridNode = hgrid [
        label "Hello",
        label "how",
        label "are you?"
      ]
    (sizeReqW, sizeReqH) = nodeGetSizeReq wenv gridNode

getSizeReqItemsV :: Spec
getSizeReqItemsV = describe "several items, vertical, one not visible" $ do
  it "should return width = Fixed 80" $
    sizeReqW `shouldBe` fixedSize 80

  it "should return height = Fixed 60" $
    sizeReqH `shouldBe` fixedSize 60

  where
    wenv = mockWenv ()
    gridNode = vgrid [
        label "Hello",
        label "how",
        label "" `nodeVisible` False,
        label "are you?"
      ]
    (sizeReqW, sizeReqH) = nodeGetSizeReq wenv gridNode

getSizeReqMixedH :: Spec
getSizeReqMixedH = describe "several items, different reqSizes" $ do
  it "should return width = Range 300 900 1 (3 * Range 100 300)" $
    sizeReqW `shouldBe` rangeSize 300 900 1

  it "should return height = Range 100 300 1" $
    sizeReqH `shouldBe` rangeSize 100 300 1

  where
    wenv = mockWenv ()
    gridNode = hgrid [
        label "Label 1" `styleBasic` [width 100, height 100],
        label "Label 2" `styleBasic` [maxWidth 300, maxHeight 300],
        label "Label 3"
      ]
    (sizeReqW, sizeReqH) = nodeGetSizeReq wenv gridNode

getSizeReqMixedV :: Spec
getSizeReqMixedV = describe "several items, different reqSizes" $ do
  it "should return width = Min 100 1" $
    sizeReqW `shouldBe` SizeReq 100 200 100 1

  it "should return height = Min 300 1 (3 * Min 100)" $
    sizeReqH `shouldBe` SizeReq 300 600 300 1

  where
    wenv = mockWenv ()
    gridNode = vgrid [
        label "Label 1" `styleBasic` [minWidth 100, minHeight 100],
        label "Label 2" `styleBasic` [maxWidth 300, maxHeight 300],
        label "Label 3"
      ]
    (sizeReqW, sizeReqH) = nodeGetSizeReq wenv gridNode

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 = mockWenv ()
    vgridNode = vgrid_ [sizeReqUpdater (fixedToMinW 2), sizeReqUpdater (fixedToMaxH 3)] [label "Label"]
    (sizeReqW, sizeReqH) = nodeGetSizeReq wenv vgridNode

getSizeReqChildSpacing :: Spec
getSizeReqChildSpacing = describe "with childSpacing" $ do
  it "should not add spacing when empty" $
    testGridSizeReq [] `shouldBe` fixedSize 0

  it "should not add spacing when singleton" $
    testGridSizeReq [spacer3] `shouldBe` fixedSize 3

  it "should add spacing between children" $
    testGridSizeReq [spacer3, spacer3] `shouldBe` fixedSize 8
  
  it "should not add spacing between invisible children" $ do
    testGridSizeReq [spacer3, spacer3 `nodeVisible` False] `shouldBe` fixedSize 3
  
  where
    wenv = mockWenv ()
    spacer3 = spacer_ [width 3, resizeFactor 0]
    testGridSizeReq children = sizeReqH where
      (_sizeReqW, sizeReqH) = nodeGetSizeReq wenv vgridNode
      vgridNode = vgrid_ [childSpacing_ 2] children

resize :: Spec
resize = describe "resize" $ do
  resizeEmpty
  resizeItemsH
  resizeItemsV
  resizeChildSpacing

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
    gridNode = vgrid []
    newNode = nodeInit wenv gridNode
    viewport = newNode ^. L.info . L.viewport
    children = newNode ^. L.children

resizeItemsH :: Spec
resizeItemsH = 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" $
    childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]

  where
    wenv = mockWenv () & L.windowSize .~ Size 480 640
    vp   = Rect   0 0 480 640
    cvp1 = Rect   0 0 160 640
    cvp2 = Rect 160 0 160 640
    cvp3 = Rect 320 0 160 640
    gridNode = hgrid [
        label "Label 1",
        label "Label Number Two",
        label "Label 3"
      ]
    newNode = nodeInit wenv gridNode
    viewport = newNode ^. L.info . L.viewport
    childrenVp = (^. L.info . L.viewport) <$> newNode ^. L.children

resizeItemsV :: Spec
resizeItemsV = describe "several items, vertical, one not visible" $ do
  it "should have the provided viewport size" $
    viewport `shouldBe` vp

  it "should assign the same viewport size to each children" $
    childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3, cvp4]

  where
    wenv = mockWenv ()
    vp   = Rect 0   0 640 480
    cvp1 = Rect 0   0 640 160
    cvp2 = Rect 0 160 640 160
    cvp3 = Rect 0   0   0   0
    cvp4 = Rect 0 320 640 160
    gridNode = vgrid [
        label "Label 1",
        label "Label Number Two",
        label "Label invisible" `nodeVisible` False,
        label "Label 3"
      ]
    newNode = nodeInit wenv gridNode
    viewport = newNode ^. L.info . L.viewport
    childrenVp = (^. L.info . L.viewport) <$> newNode ^. L.children

resizeChildSpacing :: Spec
resizeChildSpacing = describe "with childSpacing" $ do

  it "should add spacing between children" $
    testGridChildLocations [spacer, spacer] `shouldBe`
      Seq.fromList [Rect 0 0 640 215, Rect 0 265 640 215]
  
  it "should not add spacing between invisible children" $
    testGridChildLocations [spacer, spacer `nodeVisible` False, spacer] `shouldBe`
      Seq.fromList [Rect 0 0 640 215, Rect 0 0 0 0, Rect 0 265 640 215]
  
  where
    wenv = mockWenv ()
    testGridChildLocations children = childLocations where
      vgridNode = vgrid_ [childSpacing_ 50] children
      newNode = nodeInit wenv vgridNode
      childLocations = roundRectUnits . _wniViewport . _wnInfo <$> newNode ^. L.children