TextClip.hs

module Tests.TextClip
    ( tests
    )
where

import Control.Applicative
import Test.QuickCheck

import Tests.Instances ()
import qualified Data.Text as T
import Graphics.Vty.Widgets.TextClip
import Graphics.Vty.Widgets.Util

rectGen :: Gen ClipRect
rectGen = ClipRect
          <$> (arbitrary `suchThat` (>= Phys 0))
          <*> (arbitrary `suchThat` (>= Phys 0))
          <*> (arbitrary `suchThat` (>= Phys 0))
          <*> (arbitrary `suchThat` (>= Phys 0))

textGen :: Gen T.Text
textGen = T.pack <$> (listOf $ oneof [ pure 'a'
                                     , pure ' '
                                     , pure '台'
                                     ])

docGen :: Gen [T.Text]
docGen = listOf1 textGen

clip1dWidth :: Property
clip1dWidth =
    forAll rectGen $ \rect ->
        forAll textGen $ \t ->
            let (r, _, _) = clip1d (clipLeft rect) (clipWidth rect) t
            in textWidth r <= clipWidth rect

clipSliceLeft :: Bool
clipSliceLeft =
    let (_, ls, _) = clip1d (Phys 1) (Phys 2) $ T.pack "台台"
    in ls

clipSliceRight :: Bool
clipSliceRight =
    let (_, _, rs) = clip1d (Phys 1) (Phys 2) $ T.pack "台台"
    in rs

clip2dBounds :: Property
clip2dBounds =
    forAll rectGen $ \rect ->
        forAll docGen $ \t ->
            let result = clip2d rect t
                check (r, _, _) = textWidth r <= clipWidth rect
            in all check result && (Phys $ length result) <= clipHeight rect

tests :: [Property]
tests = [ label "clip1d guarantees width bound" clip1dWidth
        , label "clip1d indicates left slices" $ property clipSliceLeft
        , label "clip1d indicates right slices" $ property clipSliceRight
        , label "clip2d guarantees width and height bounds" clip2dBounds
        ]