packages feed

monomer-1.0.0.0: test/unit/Monomer/Widgets/Singles/ButtonSpec.hs

{-|
Module      : Monomer.Widgets.Singles.ButtonSpec
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 Button widget.
-}
module Monomer.Widgets.Singles.ButtonSpec (spec) where

import Control.Lens ((&), (^.), (.~))
import Data.Default
import Data.Text (Text)
import Test.Hspec

import qualified Data.Sequence as Seq
import qualified Data.Text as T

import Monomer.Core
import Monomer.Core.Combinators
import Monomer.Event
import Monomer.Graphics
import Monomer.TestEventUtil
import Monomer.TestUtil
import Monomer.Widgets.Singles.Button

import qualified Monomer.Lens as L

data BtnEvent
  = BtnClick
  | GotFocus Path
  | LostFocus Path
  deriving (Eq, Show)

spec :: Spec
spec = describe "Button" $ do
  handleEvent
  getSizeReq

handleEvent :: Spec
handleEvent = describe "handleEvent" $ do
  it "should not generate an event if clicked outside" $
    clickEvts (Point 3000 3000) `shouldBe` Seq.empty

  it "should generate a user provided event when clicked" $
    clickEvts (Point 100 100) `shouldBe` Seq.singleton BtnClick

  it "should generate a user provided event when Enter/Space is pressed" $
    keyEvts keyReturn `shouldBe` Seq.singleton BtnClick

  it "should generate an event when focus is received" $
    events evtFocus `shouldBe` Seq.singleton (GotFocus emptyPath)

  it "should generate an event when focus is lost" $
    events evtBlur `shouldBe` Seq.singleton (LostFocus emptyPath)

  where
    wenv = mockWenv ()
    btnNode = button_ "Click" BtnClick [onFocus GotFocus, onBlur LostFocus]
    clickEvts p = nodeHandleEventEvts wenv [evtClick p] btnNode
    keyEvts key = nodeHandleEventEvts wenv [KeyAction def key KeyPressed] btnNode
    events evt = nodeHandleEventEvts wenv [evt] btnNode

getSizeReq :: Spec
getSizeReq = describe "getSizeReq" $ do
  describe "fixed" $ do
    it "should return width = Fixed 50" $
      sizeReqW1 `shouldBe` fixedSize 50

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

  describe "flex" $ do
    it "should return width = Flex 70 1" $
      sizeReqW2 `shouldBe` flexSize 70 1

    it "should return height = Flex 20 2" $
      sizeReqH2 `shouldBe` flexSize 20 2

  describe "multi" $ do
    it "should return width = Fixed 50" $
      sizeReqW3 `shouldBe` fixedSize 50

    it "should return height = Flex 60 1" $
      sizeReqH3 `shouldBe` flexSize 60 1

  where
    wenv = mockWenv ()
    btnNode1 = button "Click" BtnClick
    btnNode2 = button_ "Click 2" BtnClick [resizeFactorW 1, resizeFactorH 2]
    btnNode3 = button_ "Line    line    line" BtnClick [multiline, trimSpaces] `styleBasic` [width 50]
    (sizeReqW1, sizeReqH1) = nodeGetSizeReq wenv btnNode1
    (sizeReqW2, sizeReqH2) = nodeGetSizeReq wenv btnNode2
    (sizeReqW3, sizeReqH3) = nodeGetSizeReq wenv btnNode3