FocusSpec.hs

{-|
Module      : Monomer.Widgets.Util.FocusSpec
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 Focus handling.
-}
module Monomer.Widgets.Util.FocusSpec (spec) where

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

import qualified Data.Sequence as Seq

import Monomer.Core
import Monomer.Widgets.Singles.Label
import Monomer.Widgets.Util.Focus
import Monomer.TestUtil

import qualified Monomer.Lens as L

spec :: Spec
spec = describe "Focus" $ do
  testParentPath
  testNextTargetStep
  testIsFocusCandidate

testParentPath :: Spec
testParentPath = describe "parentPath" $ do
  it "should return root path" $ do
    parentPath (pathNode []) `shouldBe` emptyPath
    parentPath (pathNode [0]) `shouldBe` emptyPath

  it "should return a single element path" $ do
    parentPath (pathNode [0, 1]) `shouldBe` Seq.fromList [0]
    parentPath (pathNode [1, 4]) `shouldBe` Seq.fromList [1]

  it "should return a multiple element path" $ do
    parentPath (pathNode [0, 1, 2]) `shouldBe` Seq.fromList [0, 1]
    parentPath (pathNode [0, 1, 2, 3, 4]) `shouldBe` Seq.fromList [0, 1, 2, 3]

testNextTargetStep :: Spec
testNextTargetStep = describe "nextTargetStep" $ do
  it "should return Nothing if next step is not valid" $ do
    nextTargetStep (pathNode []) (path []) `shouldBe` Nothing
    nextTargetStep (pathNode_ [] 5) (path []) `shouldBe` Nothing
    nextTargetStep (pathNode_ [0] 5) (path [0]) `shouldBe` Nothing
    nextTargetStep (pathNode_ [0] 5) (path [3]) `shouldBe` Nothing

  it "should return a valid target step" $ do
    nextTargetStep (pathNode_ [] 5) (path [2]) `shouldBe` Just 2
    nextTargetStep (pathNode_ [0] 5) (path [0, 3]) `shouldBe` Just 3

testIsFocusCandidate :: Spec
testIsFocusCandidate = describe "isFocusCandidate" $ do
  it "should return False if not backward candidate" $ do
    isFocusCandidate (pathNode [0]) (path [0]) FocusBwd `shouldBe` False
    isFocusCandidate (pathNode [0, 1]) (path [0, 0]) FocusBwd `shouldBe` False

  it "should return True if backward candidate" $ do
    isFocusCandidate (pathNode []) (path []) FocusBwd `shouldBe` True
    isFocusCandidate (pathNode []) (path [0]) FocusBwd `shouldBe` True
    isFocusCandidate (pathNode [0]) (path [1]) FocusBwd `shouldBe` True
    isFocusCandidate (pathNode [0, 0]) (path [0, 1]) FocusBwd `shouldBe` True
    isFocusCandidate (pathNode [0, 0]) (path [0, 0, 1]) FocusBwd `shouldBe` True
    isFocusCandidate (pathNode [0, 1, 1]) (path [0, 2]) FocusBwd `shouldBe` True

  it "should return False if not forward candidate" $ do
    isFocusCandidate (pathNode []) (path []) FocusFwd `shouldBe` False
    isFocusCandidate (pathNode []) (path [0]) FocusFwd `shouldBe` False
    isFocusCandidate (pathNode [0]) (path [1]) FocusFwd `shouldBe` False
    isFocusCandidate (pathNode [0, 0]) (path [0, 1]) FocusFwd `shouldBe` False

  it "should return True if forward candidate" $ do
    isFocusCandidate (pathNode [0]) (path []) FocusFwd `shouldBe` True
    isFocusCandidate (pathNode [1]) (path [0]) FocusFwd `shouldBe` True
    isFocusCandidate (pathNode [0, 1]) (path [0, 0]) FocusFwd `shouldBe` True
    isFocusCandidate (pathNode [0, 2]) (path [0, 1, 1]) FocusFwd `shouldBe` True

path :: [PathStep] -> Path
path p = Seq.fromList p

pathNode :: [PathStep] -> WidgetNode s e
pathNode path = pathNode_ path 0

pathNode_ :: [PathStep] -> Int -> WidgetNode s e
pathNode_ path childCount = newNode where
  mkChild idx = pathNode_ (path ++ [idx]) 0
  newNode = label "Test"
    & L.info . L.path .~ Seq.fromList path
    & L.info . L.visible .~ True
    & L.info . L.enabled .~ True
    & L.info . L.focusable .~ True
    & L.children .~ Seq.fromList (fmap mkChild [0..childCount - 1])