git.iko.soy/vty
on 5.18 help sign in
vty/test/VerifyImageOps.hs
173 lines 7.6 kB history raw
1module VerifyImageOps where
3import Graphics.Vty.Attributes
4import Graphics.Vty.Image.Internal
5import Verify.Graphics.Vty.Image
7import Verify
9import Control.DeepSeq
11twoSwHorizConcat :: SingleColumnChar -> SingleColumnChar -> Bool
12twoSwHorizConcat (SingleColumnChar c1) (SingleColumnChar c2) =
13 imageWidth (char defAttr c1 <|> char defAttr c2) == 2
15manySwHorizConcat :: [SingleColumnChar] -> Bool
16manySwHorizConcat cs =
17 let chars = [ char | SingleColumnChar char <- cs ]
18 l = fromIntegral $ length cs
19 in imageWidth ( horizCat $ map (char defAttr) chars ) == l
21twoSwVertConcat :: SingleColumnChar -> SingleColumnChar -> Bool
22twoSwVertConcat (SingleColumnChar c1) (SingleColumnChar c2) =
23 imageHeight (char defAttr c1 <-> char defAttr c2) == 2
25horizConcatSwAssoc :: SingleColumnChar -> SingleColumnChar -> SingleColumnChar -> Bool
26horizConcatSwAssoc (SingleColumnChar c0) (SingleColumnChar c1) (SingleColumnChar c2) =
27 (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2
28 ==
29 char defAttr c0 <|> (char defAttr c1 <|> char defAttr c2)
31twoDwHorizConcat :: DoubleColumnChar -> DoubleColumnChar -> Bool
32twoDwHorizConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =
33 imageWidth (char defAttr c1 <|> char defAttr c2) == 4
35manyDwHorizConcat :: [DoubleColumnChar] -> Bool
36manyDwHorizConcat cs =
37 let chars = [ char | DoubleColumnChar char <- cs ]
38 l = fromIntegral $ length cs
39 in imageWidth ( horizCat $ map (char defAttr) chars ) == l * 2
41twoDwVertConcat :: DoubleColumnChar -> DoubleColumnChar -> Bool
42twoDwVertConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =
43 imageHeight (char defAttr c1 <-> char defAttr c2) == 2
45horizConcatDwAssoc :: DoubleColumnChar -> DoubleColumnChar -> DoubleColumnChar -> Bool
46horizConcatDwAssoc (DoubleColumnChar c0) (DoubleColumnChar c1) (DoubleColumnChar c2) =
47 (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2
48 ==
49 char defAttr c0 <|> (char defAttr c1 <|> char defAttr c2)
51vertContatSingleRow :: NonEmptyList SingleRowSingleAttrImage -> Bool
52vertContatSingleRow (NonEmpty stack) =
53 let expectedHeight :: Int = length stack
54 stackImage = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack ]
55 in imageHeight stackImage == expectedHeight
57disjointHeightHorizJoin :: NonEmptyList SingleRowSingleAttrImage
58 -> NonEmptyList SingleRowSingleAttrImage
59 -> Bool
60disjointHeightHorizJoin (NonEmpty stack0) (NonEmpty stack1) =
61 let expectedHeight :: Int = max (length stack0) (length stack1)
62 stackImage0 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]
63 stackImage1 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]
64 in imageHeight (stackImage0 <|> stackImage1) == expectedHeight
67disjointHeightHorizJoinBgFill :: NonEmptyList SingleRowSingleAttrImage
68 -> NonEmptyList SingleRowSingleAttrImage
69 -> Bool
70disjointHeightHorizJoinBgFill (NonEmpty stack0) (NonEmpty stack1) =
71 let stackImage0 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]
72 stackImage1 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]
73 image = stackImage0 <|> stackImage1
74 expectedHeight = imageHeight image
75 in case image of
76 HorizJoin {} -> ( expectedHeight == (imageHeight $ partLeft image) )
77 &&
78 ( expectedHeight == (imageHeight $ partRight image) )
79 _ -> True
81disjointWidthVertJoin :: NonEmptyList SingleRowSingleAttrImage
82 -> NonEmptyList SingleRowSingleAttrImage
83 -> Bool
84disjointWidthVertJoin (NonEmpty stack0) (NonEmpty stack1) =
85 let expectedWidth = maximum $ map imageWidth (stack0Images ++ stack1Images)
86 stack0Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]
87 stack1Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]
88 stack0Image = vertCat stack0Images
89 stack1Image = vertCat stack1Images
90 image = stack0Image <-> stack1Image
91 in imageWidth image == expectedWidth
93disjointWidthVertJoinBgFill :: NonEmptyList SingleRowSingleAttrImage
94 -> NonEmptyList SingleRowSingleAttrImage
95 -> Bool
96disjointWidthVertJoinBgFill (NonEmpty stack0) (NonEmpty stack1) =
97 let expectedWidth = maximum $ map imageWidth (stack0Images ++ stack1Images)
98 stack0Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]
99 stack1Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]
100 stack0Image = vertCat stack0Images
101 stack1Image = vertCat stack1Images
102 image = stack0Image <-> stack1Image
103 in case image of
104 VertJoin {} -> ( expectedWidth == (imageWidth $ partTop image) )
105 &&
106 ( expectedWidth == (imageWidth $ partBottom image) )
107 _ -> True
109translationIsLinearOnOutSize :: Translation -> Bool
110translationIsLinearOnOutSize (Translation i (x,y) i') =
111 imageWidth i' == imageWidth i + x && imageHeight i' == imageHeight i + y
113paddingIsLinearOnOutSize :: Image -> Gen Bool
114paddingIsLinearOnOutSize i = do
115 l <- offset
116 t <- offset
117 r <- offset
118 b <- offset
119 let i' = pad l t r b i
120 return $ imageWidth i' == imageWidth i + l + r && imageHeight i' == imageHeight i + t + b
121 where offset = choose (1,1024)
123cropLeftLimitsWidth :: Image -> Int -> Property
124cropLeftLimitsWidth i v = v >= 0 ==>
125 v >= imageWidth (cropLeft v i)
127cropRightLimitsWidth :: Image -> Int -> Property
128cropRightLimitsWidth i v = v >= 0 ==>
129 v >= imageWidth (cropRight v i)
131cropTopLimitsHeight :: Image -> Int -> Property
132cropTopLimitsHeight i v = v >= 0 ==>
133 v >= imageHeight (cropTop v i)
135cropBottomLimitsHeight :: Image -> Int -> Property
136cropBottomLimitsHeight i v = v >= 0 ==>
137 v >= imageHeight (cropBottom v i)
139-- rediculous tests just to satisfy my desire for nice code coverage :-P
140canShowImage :: Image -> Bool
141canShowImage i = length (show i) > 0
143canRnfImage :: Image -> Bool
144canRnfImage i = rnf i == ()
146canPpImage :: Image -> Bool
147canPpImage i = length (ppImageStructure i) > 0
149tests :: IO [Test]
150tests = return
151 [ verify "twoSwHorizConcat" twoSwHorizConcat
152 , verify "manySwHorizConcat" manySwHorizConcat
153 , verify "twoSwVertConcat" twoSwVertConcat
154 , verify "horizConcatSwAssoc" horizConcatSwAssoc
155 , verify "manyDwHorizConcat" manyDwHorizConcat
156 , verify "twoDwHorizConcat" twoDwHorizConcat
157 , verify "twoDwVertConcat" twoDwVertConcat
158 , verify "horizConcatDwAssoc" horizConcatDwAssoc
159 , verify "single row vert concats to correct height" vertContatSingleRow
160 , verify "disjointHeightHorizJoin" disjointHeightHorizJoin
161 , verify "disjointHeightHorizJoin BG fill" disjointHeightHorizJoinBgFill
162 , verify "disjointWidthVertJoin" disjointWidthVertJoin
163 , verify "disjointWidthVertJoin BG fill" disjointWidthVertJoinBgFill
164 , verify "translation effects output dimensions linearly" translationIsLinearOnOutSize
165 , verify "padding effects output dimensions linearly" paddingIsLinearOnOutSize
166 , verify "crop left limits width" cropLeftLimitsWidth
167 , verify "crop right limits width" cropRightLimitsWidth
168 , verify "crop top limits height" cropTopLimitsHeight
169 , verify "crop bottom limits height" cropBottomLimitsHeight
170 , verify "can show image" canShowImage
171 , verify "can rnf image" canRnfImage
172 , verify "can pp image" canPpImage
173 ]