vty-5.26: test/VerifySimpleSpanGeneration.hs

{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
module VerifySimpleSpanGeneration where

import Verify.Graphics.Vty.Prelude

import Verify.Graphics.Vty.Image
import Verify.Graphics.Vty.Picture
import Verify.Graphics.Vty.Span

import Graphics.Vty.Debug
import Graphics.Vty.PictureToSpans

import Verify

import qualified Data.Vector as Vector

unitImageAndZeroWindow0 :: UnitImage -> EmptyWindow -> Bool
unitImageAndZeroWindow0 (UnitImage _ i) (EmptyWindow w) =
    let p = picForImage i
        ops = displayOpsForPic p (regionForWindow w)
    in displayOpsColumns ops == 0 && displayOpsRows ops == 0

unitImageAndZeroWindow1 :: UnitImage -> EmptyWindow -> Bool
unitImageAndZeroWindow1 (UnitImage _ i) (EmptyWindow w) =
    let p = picForImage i
        ops = displayOpsForPic p (regionForWindow w)
    in ( spanOpsAffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

horizSpanImageAndZeroWindow0 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool
horizSpanImageAndZeroWindow0 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =
    let p = picForImage i
        ops = displayOpsForPic p (regionForWindow w)
    in displayOpsColumns ops == 0 && displayOpsRows ops == 0

horizSpanImageAndZeroWindow1 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool
horizSpanImageAndZeroWindow1 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =
    let p = picForImage i
        ops = displayOpsForPic p (regionForWindow w)
    in ( spanOpsAffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

horizSpanImageAndEqualWindow0 :: SingleRowSingleAttrImage -> Result
horizSpanImageAndEqualWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =
    let p = picForImage i
        w = MockWindow c 1
        ops = displayOpsForPic p (regionForWindow w)
    in verifyAllSpansHaveWidth i ops c

horizSpanImageAndEqualWindow1 :: SingleRowSingleAttrImage -> Bool
horizSpanImageAndEqualWindow1 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =
    let p = picForImage i
        w = MockWindow c 1
        ops = displayOpsForPic p (regionForWindow w)
    in spanOpsAffectedRows ops == 1

horizSpanImageAndLesserWindow0 :: SingleRowSingleAttrImage -> Result
horizSpanImageAndLesserWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =
    let p = picForImage i
        lesserWidth = c `div` 2
        w = MockWindow lesserWidth 1
        ops = displayOpsForPic p (regionForWindow w)
    in verifyAllSpansHaveWidth i ops lesserWidth

singleAttrSingleSpanStackCropped0 :: SingleAttrSingleSpanStack -> Result
singleAttrSingleSpanStackCropped0 stack =
    let p = picForImage (stackImage stack)
        w = MockWindow (stackWidth stack `div` 2) (stackHeight stack)
        ops = displayOpsForPic p (regionForWindow w)
    in verifyAllSpansHaveWidth (stackImage stack) ops (stackWidth stack `div` 2)

singleAttrSingleSpanStackCropped1 :: SingleAttrSingleSpanStack -> Bool
singleAttrSingleSpanStackCropped1 stack =
    let p = picForImage (stackImage stack)
        expectedRowCount = stackHeight stack `div` 2
        w = MockWindow (stackWidth stack) expectedRowCount
        ops = displayOpsForPic p (regionForWindow w)
        actualRowCount = spanOpsAffectedRows ops
    in expectedRowCount == actualRowCount

singleAttrSingleSpanStackCropped2 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result
singleAttrSingleSpanStackCropped2 stack0 stack1 =
    let p = picForImage (stackImage stack0 <|> stackImage stack1)
        w = MockWindow (stackWidth stack0) (imageHeight (picImage p))
        ops = displayOpsForPic p (regionForWindow w)
    in verifyAllSpansHaveWidth (picImage p) ops (stackWidth stack0)

singleAttrSingleSpanStackCropped3 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool
singleAttrSingleSpanStackCropped3 stack0 stack1 =
    let p = picForImage (stackImage stack0 <|> stackImage stack1)
        w = MockWindow (imageWidth (picImage p))  expectedRowCount
        ops = displayOpsForPic p (regionForWindow w)
        expectedRowCount = imageHeight (picImage p) `div` 2
        actualRowCount = spanOpsAffectedRows ops
    in expectedRowCount == actualRowCount

singleAttrSingleSpanStackCropped4 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result
singleAttrSingleSpanStackCropped4 stack0 stack1 =
    let p = picForImage (stackImage stack0 <-> stackImage stack1)
        w = MockWindow expectedWidth (imageHeight (picImage p))
        ops = displayOpsForPic p (regionForWindow w)
        expectedWidth = imageWidth (picImage p) `div` 2
    in verifyAllSpansHaveWidth (picImage p) ops expectedWidth

singleAttrSingleSpanStackCropped5 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool
singleAttrSingleSpanStackCropped5 stack0 stack1 =
    let p = picForImage (stackImage stack0 <-> stackImage stack1)
        w = MockWindow (imageWidth (picImage p)) (stackHeight stack0)
        ops = displayOpsForPic p (regionForWindow w)
        expectedRowCount = stackHeight stack0
        actualRowCount = spanOpsAffectedRows ops
    in expectedRowCount == actualRowCount

horizSpanImageAndGreaterWindow0 :: SingleRowSingleAttrImage -> Result
horizSpanImageAndGreaterWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =
    let p = picForImage i
        -- SingleRowSingleAttrImage always has width >= 1
        greaterWidth = c * 2
        w = MockWindow greaterWidth 1
        ops = displayOpsForPic p (regionForWindow w)
    in verifyAllSpansHaveWidth i ops greaterWidth

arbImageIsCropped :: DefaultImage -> MockWindow -> Bool
arbImageIsCropped (DefaultImage image) win@(MockWindow w h) =
    let pic = picForImage image
        ops = displayOpsForPic pic (regionForWindow win)
    in ( spanOpsAffectedRows ops == h ) && ( allSpansHaveWidth ops w )

spanOpsActuallyFillRows :: DefaultPic -> Bool
spanOpsActuallyFillRows (DefaultPic pic win) =
    let ops = displayOpsForPic pic (regionForWindow win)
        expectedRowCount = regionHeight (regionForWindow win)
        actualRowCount = spanOpsAffectedRows ops
    in expectedRowCount == actualRowCount

spanOpsActuallyFillColumns :: DefaultPic -> Bool
spanOpsActuallyFillColumns (DefaultPic pic win) =
    let ops = displayOpsForPic pic (regionForWindow win)
        expectedColumnCount = regionWidth (regionForWindow win)
    in allSpansHaveWidth ops expectedColumnCount

firstSpanOpSetsAttr :: DefaultPic -> Bool
firstSpanOpSetsAttr DefaultPic { defaultPic = pic, defaultWin = win } =
    let ops = displayOpsForPic pic (regionForWindow win)
    in all ( isAttrSpanOp . Vector.head ) ( Vector.toList ops )

singleAttrSingleSpanStackOpCoverage ::  SingleAttrSingleSpanStack -> Result
singleAttrSingleSpanStackOpCoverage stack =
    let p = picForImage (stackImage stack)
        w = MockWindow (stackWidth stack) (stackHeight stack)
        ops = displayOpsForPic p (regionForWindow w)
    in verifyAllSpansHaveWidth (stackImage stack) ops (stackWidth stack)

imageCoverageMatchesBounds :: Image -> Result
imageCoverageMatchesBounds i =
    let p = picForImage i
        r = (imageWidth i,imageHeight i)
        ops = displayOpsForPic p r
    in verifyAllSpansHaveWidth i ops (imageWidth i)

tests :: IO [Test]
tests = return
    [ verify "unit image is cropped when window size == (0,0) [0]" unitImageAndZeroWindow0
    , verify "unit image is cropped when window size == (0,0) [1]" unitImageAndZeroWindow1
    , verify "horiz span image is cropped when window size == (0,0) [0]" horizSpanImageAndZeroWindow0
    , verify "horiz span image is cropped when window size == (0,0) [1]" horizSpanImageAndZeroWindow1
    , verify "horiz span image is not cropped when window size == size of image [width]" horizSpanImageAndEqualWindow0
    , verify "horiz span image is not cropped when window size == size of image [height]" horizSpanImageAndEqualWindow1
    , verify "horiz span image is not cropped when window size < size of image [width]" horizSpanImageAndLesserWindow0
    , verify "horiz span image is not cropped when window size > size of image [width]" horizSpanImageAndGreaterWindow0
    , verify "first span op is always to set the text attribute" firstSpanOpSetsAttr
    , verify "a stack of single attr text spans should define content for all the columns [output region == size of stack]"
        singleAttrSingleSpanStackOpCoverage
    , verify "a single attr text span is cropped when window size < size of stack image [width]"
        singleAttrSingleSpanStackCropped0
    , verify "a single attr text span is cropped when window size < size of stack image [height]"
        singleAttrSingleSpanStackCropped1
    , verify "single attr text span <|> single attr text span display cropped. [width]"
        singleAttrSingleSpanStackCropped2
    , verify "single attr text span <|> single attr text span display cropped. [height]"
        singleAttrSingleSpanStackCropped3
    , verify "single attr text span <-> single attr text span display cropped. [width]"
        singleAttrSingleSpanStackCropped4
    , verify "single attr text span <-> single attr text span display cropped. [height]"
        singleAttrSingleSpanStackCropped5
    , verify "an arbitrary image when rendered to a window of the same size will cover the entire window"
        imageCoverageMatchesBounds
    ]