{-| Module : Monomer.Widgets.Singles.LabelSpec 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 Label widget. -} module Monomer.Widgets.Singles.LabelSpec (spec) where import Control.Lens ((&), (^.), (^?!), (.~), ix) 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.TestUtil import Monomer.Widgets.Singles.Label import qualified Monomer.Lens as L spec :: Spec spec = describe "Label" $ do getSizeReq getSizeReqMulti getSizeReqMultiKeepSpaces getSizeReqMultiMaxLines getSizeReqMerge resize getSizeReq :: Spec getSizeReq = describe "getSizeReq" $ do it "should return width = Fixed 100" $ sizeReqW `shouldBe` fixedSize 100 it "should return height = Fixed 20" $ sizeReqH `shouldBe` fixedSize 20 it "should return width = Flex 120 1" $ sizeReq2W `shouldBe` flexSize 120 1 it "should return height = Flex 20 2" $ sizeReq2H `shouldBe` flexSize 20 2 it "should return width = Flex 120 1" $ sizeReq3W `shouldBe` flexSize 120 0.01 it "should return height = Flex 20 2" $ sizeReq3H `shouldBe` flexSize 20 0.01 where wenv = mockWenv () lblNode = label "Test label" lblNode2 = label_ "Test label 2" [resizeFactorW 1, resizeFactorH 2] lblNode3 = label_ "Test label 3" [ellipsis] (sizeReqW, sizeReqH) = nodeGetSizeReq wenv lblNode (sizeReq2W, sizeReq2H) = nodeGetSizeReq wenv lblNode2 (sizeReq3W, sizeReq3H) = nodeGetSizeReq wenv lblNode3 getSizeReqMulti :: Spec getSizeReqMulti = describe "getSizeReq" $ do it "should return width = Fixed 50" $ sizeReqW `shouldBe` fixedSize 50 it "should return height = Flex 60 1" $ sizeReqH `shouldBe` flexSize 60 1 where wenv = mockWenv () lblNode = label_ "Line line line" [multiline, trimSpaces] `styleBasic` [width 50] (sizeReqW, sizeReqH) = nodeGetSizeReq wenv lblNode getSizeReqMultiKeepSpaces :: Spec getSizeReqMultiKeepSpaces = describe "getSizeReq" $ do it "should return width = Max 50 1" $ sizeReqW `shouldBe` maxSize 50 1 it "should return height = Flex 100 1" $ sizeReqH `shouldBe` flexSize 100 1 where wenv = mockWenv () caption = "Line line line" lblNode = label_ caption [multiline, trimSpaces_ False] `styleBasic` [maxWidth 50] (sizeReqW, sizeReqH) = nodeGetSizeReq wenv lblNode getSizeReqMultiMaxLines :: Spec getSizeReqMultiMaxLines = describe "getSizeReq" $ do it "should return width = Max 50 1" $ sizeReqW `shouldBe` maxSize 50 1 it "should return height = Flex 80 1" $ sizeReqH `shouldBe` flexSize 80 1 where wenv = mockWenv () caption = "Line line line line line" lblNode = label_ caption [multiline, trimSpaces_ False, maxLines 4] `styleBasic` [maxWidth 50] (sizeReqW, sizeReqH) = nodeGetSizeReq wenv lblNode getSizeReqMerge :: Spec getSizeReqMerge = describe "getSizeReqMerge" $ do it "should return width = Fixed 320" $ sizeReqW `shouldBe` fixedSize 320 it "should return height = Fixed 20" $ sizeReqH `shouldBe` fixedSize 20 it "should return width = Fixed 600" $ sizeReq2W `shouldBe` fixedSize 600 it "should return height = Fixed 20" $ sizeReq2H `shouldBe` fixedSize 20 where fontMgr = mockFontManager { computeGlyphsPos = mockGlyphsPos Nothing 1 } wenv = mockWenvEvtUnit () & L.fontManager .~ fontMgr lblNode = nodeInit wenv (label "Test Label") lblNode2 = label "Test Label" `styleBasic` [textSize 60] lblRes = widgetMerge (lblNode2 ^. L.widget) wenv lblNode2 lblNode WidgetResult lblMerged _ = lblRes lblInfo = lblNode ^. L.info mrgInfo = lblMerged ^. L.info (sizeReqW, sizeReqH) = (lblInfo ^. L.sizeReqW, lblInfo ^. L.sizeReqH) (sizeReq2W, sizeReq2H) = (mrgInfo ^. L.sizeReqW, mrgInfo ^. L.sizeReqH) resize :: Spec resize = describe "resize" $ do it "should resize single line in a single step" $ reqsSingle `shouldBe` Seq.Empty it "should resize multi line in two steps" $ reqsMulti ^?! ix 0 `shouldSatisfy` isResizeWidgets where wenv = mockWenvEvtUnit () vp = Rect 0 0 640 480 single = label "Test label" resizeCheck = const True resSingle = widgetResize (single ^. L.widget) wenv single vp resizeCheck reqsSingle = resSingle ^. L.requests multi = label_ "Test label" [multiline] resMulti = widgetResize (multi ^. L.widget) wenv multi vp resizeCheck reqsMulti = resMulti ^. L.requests