TimeFieldSpec.hs

{-|
Module      : Monomer.Widgets.Singles.TimeFieldSpec
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 TimeField widget.
-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

module Monomer.Widgets.Singles.TimeFieldSpec (spec) where

import Control.Lens ((&), (^.), (.~))
import Control.Lens.TH (abbreviatedFields, makeLensesWith)
import Data.Default
import Data.Text (Text)
import Data.Time
import Test.Hspec

import qualified Data.Sequence as Seq

import Monomer.Core
import Monomer.Core.Combinators
import Monomer.Event
import Monomer.TestUtil
import Monomer.TestEventUtil
import Monomer.Widgets.Containers.Stack
import Monomer.Widgets.Singles.Button
import Monomer.Widgets.Singles.TimeField

import qualified Monomer.Lens as L

data TestEvt
  = TimeChanged TimeOfDay
  | TimeValid Bool
  | GotFocus Path
  | LostFocus Path
  deriving (Eq, Show)

data TimeModel = TimeModel {
  _imTimeValue :: TimeOfDay,
  _imTimeValid :: Bool
} deriving (Eq, Show)

instance Default TimeModel where
  def = TimeModel {
    _imTimeValue = midnight,
    _imTimeValid = True
  }

data MTimeModel = MTimeModel {
  _imMTimeValue :: Maybe TimeOfDay,
  _imMTimeValid :: Bool
} deriving (Eq, Show)

instance Default MTimeModel where
  def = MTimeModel {
    _imMTimeValue = Nothing,
    _imMTimeValid = True
  }

makeLensesWith abbreviatedFields ''TimeModel
makeLensesWith abbreviatedFields ''MTimeModel

spec :: Spec
spec = describe "TimeField" $ do
  handleEventTime
  handleEventValueTime
  handleEventMouseDragTime
  handleEventReadOnly
  handleShiftFocus
  getSizeReqTime
  testWidgetType

handleEventTime :: Spec
handleEventTime = describe "handleEventTime" $ do
  it "should remove the contents and get Nothing as model value" $ do
    modelBasic [evtKG keyA, evtK keyBackspace] ^. mTimeValue `shouldBe` Nothing
    modelBasic [evtKG keyA, evtK keyBackspace] ^. mTimeValid `shouldBe` True

  it "should input '01:30'" $ do
    modelBasic [evtKG keyA, evtT "01", evtT ":30"] ^. mTimeValue `shouldBe` Just (TimeOfDay 1 30 0)
    modelBasic [evtKG keyA, evtT "01", evtT ":30"] ^. mTimeValid `shouldBe` True

  it "should input '1' (invalid time)" $ do
    model [evtKG keyA, evtT "1"] ^. mTimeValue `shouldBe` Just midTime
    model [evtKG keyA, evtT "1"] ^. mTimeValid `shouldBe` False
    events [evtKG keyA, evtT "1"] `shouldBe` Seq.fromList [TimeValid False]

  it "should input '02:35' but fail because of minValue" $ do
    model [evtT "02:35"] ^. mTimeValue `shouldBe` Just midTime
    model [evtT "02:35"] ^. mTimeValid `shouldBe` False
    events [evtT "02:35"] `shouldBe` Seq.fromList [TimeValid False]

  it "should input '23:50' but fail because of maxValue" $ do
    model [evtT "23:50"] ^. mTimeValue `shouldBe` Just midTime
    model [evtT "23:50"] ^. mTimeValid `shouldBe` False
    events [evtT "23:50"] `shouldBe` Seq.fromList [TimeValid False]

  it "should remove one character and input '4'" $ do
    model [moveCharR, delCharL, evtT "4"] ^. mTimeValue `shouldBe` Just (TimeOfDay 14 24 0)
    model [moveCharR, delCharL, evtT "4"] ^. mTimeValid `shouldBe` True
    events [moveCharR, delCharL, evtT "4"] `shouldBe` Seq.fromList [TimeValid True, TimeValid True]

  it "should input '22:30', remove one word and input '15'" $ do
    model [evtT "22:30", delWordL, evtT "15"] ^. mTimeValue `shouldBe` Just (TimeOfDay 22 15 0)
    model [evtT "22:30", delWordL, evtT "15"] ^. mTimeValid `shouldBe` True
    events [evtT "22:30", delWordL, evtT "15"] `shouldBe` Seq.fromList [TimeValid True, TimeValid False, TimeValid True]

  it "should update the model when using the wheel" $ do
    let p = Point 100 10
    let steps1 = [WheelScroll p (Point 0 (-2000)) WheelNormal]
    let steps2 = [WheelScroll p (Point 0 (-64)) WheelNormal]
    let steps3 = [WheelScroll p (Point 0 64) WheelNormal]
    let steps4 = [WheelScroll p (Point 0 (-2000)) WheelFlipped]
    model steps1 ^. mTimeValue `shouldBe` Just minTime
    model steps2 ^. mTimeValue `shouldBe` Just (TimeOfDay 13 16 0)
    model steps3 ^. mTimeValue `shouldBe` Just (TimeOfDay 15 24 0)
    model steps4 ^. mTimeValue `shouldBe` Just maxTime

  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
    minTime = TimeOfDay 3 15 0
    midTime = TimeOfDay 14 20 0
    maxTime = TimeOfDay 23 45 0
    wenv = mockWenv (MTimeModel (Just midTime) True)
    basicTimeNode :: WidgetNode MTimeModel TestEvt
    basicTimeNode = timeField_ mTimeValue [validInput mTimeValid, selectOnFocus_ False]
    timeCfg = [minValue (Just minTime), maxValue (Just maxTime), validInput mTimeValid, validInputV TimeValid, onFocus GotFocus, onBlur LostFocus]
    timeNode = timeField_ mTimeValue timeCfg
    model es = nodeHandleEventModel wenv (evtFocus : es) timeNode
    modelBasic es = nodeHandleEventModel wenv es basicTimeNode
    events es = nodeHandleEventEvts wenv es timeNode

handleEventValueTime :: Spec
handleEventValueTime = describe "handleEventTime" $ do
  it "should input an '12:07:48'" $
    evts [evtT "12:07:48"] `shouldBe` Seq.fromList [TimeChanged (TimeOfDay 12 07 48)]

  it "should move right, delete one character and input '5'" $ do
    let steps = [moveCharR, delCharL, evtT "5"]
    lastEvt steps `shouldBe` TimeChanged (TimeOfDay 13 35 25)
    model steps ^. timeValid `shouldBe` True

  it "should move right and delete one word" $ do
    let steps = [moveCharR, delWordL]
    evts steps `shouldBe` Seq.empty
    model steps ^. timeValid `shouldBe` False

  it "should input '04:20:', input '.', 'a', then input '10'" $ do
    let steps = [evtT "04:20:", evtT ".", evtT "a", evtT "10"]
    lastEvt steps `shouldBe` TimeChanged lowTime
    model steps ^. timeValid `shouldBe` True

  it "should input '22:5644:4555'" $ do
    let steps = [evtT "22", evtT ":56", evtT "44", evtT ":45", evtT "55"]
    lastEvt steps `shouldBe` TimeChanged maxTime

  where
    minTime = TimeOfDay 1 35 30
    lowTime = TimeOfDay 4 20 10
    midTime = TimeOfDay 13 35 20
    maxTime = TimeOfDay 22 56 45
    wenv = mockWenv (TimeModel minTime True)
    timeNode = timeFieldV_ midTime TimeChanged [minValue minTime, maxValue maxTime, selectOnFocus, validInput timeValid, timeFormatHHMMSS]
    evts es = nodeHandleEventEvts wenv (evtFocus : es) timeNode
    model es = nodeHandleEventModel wenv (evtFocus : es) timeNode
    lastIdx es = Seq.index es (Seq.length es - 1)
    lastEvt es = lastIdx (evts es)

handleEventMouseDragTime :: Spec
handleEventMouseDragTime = describe "handleEventMouseDragTime" $ do
  it "should drag upwards 100 pixels, setting the value to 18:50:15" $ do
    let selStart = Point 50 50
    let selEnd = Point 50 (-70)
    let steps = [evtPress selStart, evtMove selEnd, evtRelease selEnd]
    model steps ^. timeValue `shouldBe` TimeOfDay 18 50 15

  it "should drag downwards 100 pixels, setting the value to 11:30:15 (dragRate = 2)" $ do
    let selStart = Point 50 50
    let selEnd = Point 50 150
    let steps = [evtPress selStart, evtMove selEnd, evtRelease selEnd]
    model steps ^. timeValue `shouldBe` TimeOfDay 11 30 15

  it "should drag downwards 10000 pixels, staying at minTime (the minimum)" $ do
    let selStart = Point 50 50
    let selEnd = Point 50 10050
    let steps = [evtPress selStart, evtMove selEnd, evtRelease selEnd]
    model steps ^. timeValue `shouldBe` minTime

  it "should drag upwnwards 10000 pixels, staying at maxTime (the maximum)" $ do
    let selStart = Point 50 50
    let selEnd = Point 50 (-1950)
    let steps = [evtPress selStart, evtMove selEnd, evtRelease selEnd]
    model steps ^. timeValue `shouldBe` maxTime

  it "should drag downwards 30 and 20 pixels, setting the value to 14:30:15" $ do
    let selStart = Point 50 50
    let selMid = Point 50 60
    let selEnd = Point 50 50
    let steps = [
          evtPress selStart, evtMove selMid, evtRelease selMid,
          evtPress selStart, evtMove selEnd, evtRelease selEnd
          ]
    model steps ^. timeValue `shouldBe` TimeOfDay 14 30 15

  it "should set focus and drag upwards 100 pixels, but value stay at midTime since shift is not pressed" $ do
    let selStart = Point 50 50
    let selEnd = Point 50 (-70)
    let steps = [evtK keyTab, evtPress selStart, evtMove selEnd, evtRelease selEnd]
    model steps ^. timeValue `shouldBe` midTime

  it "should set focus and drag upwards 100 pixels, setting the value to 18:50:15 since shift is pressed" $ do
    let selStart = Point 50 50
    let selEnd = Point 50 (-70)
    let steps = [evtKS keyTab, evtPress selStart, evtMove selEnd, evtRelease selEnd]
    model steps ^. timeValue `shouldBe` TimeOfDay 18 50 15

  it "should drag upwards 100 pixels, setting the value to 18:50:15 even if it was double clicked on" $ do
    let selStart = Point 50 50
    let selEnd = Point 50 (-70)
    let steps = [evtDblClick selStart, evtPress selStart, evtMove selEnd, evtRelease selEnd]
    model steps ^. timeValue `shouldBe` TimeOfDay 18 50 15

  it "should generate a focus event when clicked" $ do
    let p = Point 50 50
    -- Presses a key to reset the shift = true state
    evts [evtK keyA, evtPress p] `shouldBe` Seq.singleton (GotFocus (Seq.fromList [0, 0]))

  it "should not generate a focus event when clicked if shift is pressed" $ do
    let p = Point 50 50
    evts [evtKS keyA, evtPress p] `shouldBe` Seq.empty

  where
    minTime = TimeOfDay 01 20 30
    midTime = TimeOfDay 14 50 15
    maxTime = TimeOfDay 23 40 50
    wenv = mockWenv (TimeModel midTime True)
      & L.inputStatus . L.keyMod . L.leftShift .~ True
    timeNode = vstack [
        button "Test" (TimeChanged midTime), -- Used only to have focus
        timeField timeValue,
        timeField_ timeValue [dragRate 2, minValue minTime, maxValue maxTime, timeFormatHHMMSS, onFocus GotFocus]
      ]
    evts es = nodeHandleEventEvts wenv es timeNode
    model es = nodeHandleEventModel wenv es timeNode
    lastIdx es = Seq.index es (Seq.length es - 1)
    lastEvt es = lastIdx (evts es)

handleEventReadOnly :: Spec
handleEventReadOnly = describe "handleEventReadOnly" $ do
  it "should ignore text input" $ do
    let steps = [moveCharR, delCharL, evtT "5"]
    model steps ^. timeValue `shouldBe` initTime
  
  it "should ignore drag" $ do
    let selStart = Point 5 5
    let selEnd = Point 100 2000
    let steps = [evtPress selStart, evtMove selEnd, evtRelease selEnd]
    model steps ^. timeValue `shouldBe` initTime

  it "should ignore wheel" $ do
    let steps = [WheelScroll (Point 100 10) (Point 0 (-2000)) WheelNormal]
    model steps ^. timeValue `shouldBe` initTime
  
  where
    initTime = TimeOfDay 20 37 00
    wenv = mockWenv (TimeModel initTime False)
      & L.inputStatus . L.keyMod . L.leftShift .~ True
    timeCfg = [readOnly :: TimeFieldCfg TimeModel TestEvt TimeOfDay]
    timeNode = timeField_ timeValue timeCfg
    model es = nodeHandleEventModel wenv es timeNode

handleShiftFocus :: Spec
handleShiftFocus = describe "handleShiftFocus" $ do
  it "should set focus when clicked" $ do
    evts [evtPress p] `shouldBe` Seq.fromList [GotFocus $ Seq.fromList [0, 0]]

  it "should not set focus when clicked with shift pressed" $ do
    evts [evtKS keyA, evtPress p] `shouldBe` Seq.empty

  where
    wenv = mockWenv (TimeModel (TimeOfDay 14 50 15) True)
    p = Point 100 30
    floatNode = vstack [
        timeField_ timeValue [wheelRate 1],
        timeField_ timeValue [wheelRate 1, onFocus GotFocus]
      ]
    evts es = nodeHandleEventEvts wenv es floatNode

getSizeReqTime :: Spec
getSizeReqTime = describe "getSizeReqTime" $ do
  it "should return width = Flex 160 1" $
    sizeReqW `shouldBe` expandSize 160 1

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

  it "should return width = Flex 100 1 when resizeOnChange = True" $
    sizeReqW2 `shouldBe` expandSize 100 1

  it "should return height = Fixed 20 when resizeOnChange = True" $
    sizeReqH2 `shouldBe` fixedSize 20

  where
    wenv = mockWenvEvtUnit (def :: TimeModel)
    (sizeReqW, sizeReqH) = nodeGetSizeReq wenv (timeField timeValue)
    timeResize = timeField_ timeValue [resizeOnChange]
    (sizeReqW2, sizeReqH2) = nodeGetSizeReq wenv timeResize

testWidgetType :: Spec
testWidgetType = describe "testWidgetType" $ do
  it "should set the correct widgetType" $
    node ^. L.info . L.widgetType `shouldBe` "timeField-TimeOfDay"

  where
    node :: WidgetNode TimeModel TestEvt
    node = timeField timeValue