itemfield-1.1.0.1: test/test_layout.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Main where
import Test.HUnit
import Test.QuickCheck
import Test.Framework
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2
import qualified Data.Text as T
import Data.Default
import Data.Monoid
import Control.Monad
import Brick.AttrMap (AttrName)
import TextUI.ItemField
import TextUI.ItemField.Layout
import Graphics.Vty.Image
import TestDataGen
main = defaultMain tests
instance Arbitrary LinePosRange where
arbitrary = liftM2 LinePosRange (choose (0,500)) (choose (0,500))
shrink (LinePosRange a b) = [LinePosRange a' b'
| a' <- shrink a, b' <- shrink b]
maxItemGroupLine = maximum . (:) 0 . map groupsize . items
where groupsize (ItemGroup g r) = T.length g + 1 + groupsize r
groupsize _ = 0
maxLongGroupLine width = foldl maxLongLine 0 . map fullsize . items
where fullsize (ItemGroup g r) =
let gsize = T.length g + 1
subsize = fullsize r
in (fst subsize + gsize, snd subsize + gsize)
fullsize (Items n) = (0, n) -- + 1)
maxLongLine o (g,n) = if g >= width then max o n else o
maxItemLine = maximum . ((:) 0) . map linesize . items
where linesize (ItemGroup g r) = T.length g + 1 + linesize r
linesize (Items n) = n
tests =
[ testGroup "RenderData"
[ testCase "Empty Lines" $ [] @=? renderedLines (RenderData 1 [])
, testProperty "recover lines" recover_lines
, testProperty "rendered width calculation" $
\f lpr1 lpr2 ->
let (rdata,img) = itemFieldRender (ItemFieldWidget "hi" f) def w h
w = lineWidth lpr1
h = lineWidth lpr2
expected_width = if maxItemGroupLine f >= w
then maxLongGroupLine w f
else w
in expected_width == renderWidth rdata
-- , testProperty "render zero items" $
-- \w h -> w == (renderWidth $ fst $
-- itemFieldRender (ItemFieldWidget "hi" $
-- newItemField [Items 0] Nothing) def w h)
, testCase "rendered width no items show centered empty message" $
let (rdata,img) = itemFieldRender (ItemFieldWidget "hi" f) def w 100
f = newItemField [] Nothing
w = 100
in assertEqual "" w (imageWidth img)
, testCase "rendered width zero items" $
let (rdata,img) = itemFieldRender (ItemFieldWidget "hi" f) def 100 100
f = newItemField [Items 0] $ Just $ \a b -> "hi"
in assertEqual "" 100 (imageWidth img) -- shows none message
, testCase "rendered width too many items" $
let (rdata,img) = itemFieldRender (ItemFieldWidget "hi" f) def w 3
f = newItemField [Items 100] $ Just $ \a b -> "hi"
w = 5
in assertEqual "" w (imageWidth img)
, testProperty "rendered width" $ prop_render_width
, testCase "single group, one item per line, width" $
let (rdata,img) = itemFieldRender (ItemFieldWidget "hi" f) def w h
w = 11
h = 500
expected_width = 11
f = newItemField
[ItemGroup "grp1" (ItemGroup "grp0" (Items 4))]
Nothing
in assertEqual "" expected_width (imageWidth img)
]
, testGroup "LineIndices"
[ testProperty "Initial 0" line_index_zero_start
, testProperty "Final count" line_index_final_length
, testCase "No elements"
$ (null $ lineIndices []) @? "empty output for empty input"
, testCase "Zero size first element"
$ Just 4 @=? (lineLastIndex $
last $ lineIndices [ LinePosRange 3 0
, LinePosRange 10 5
])
, testCase "Zero size middle element"
$ Just 7 @=? (lineLastIndex $
last $ lineIndices [ LinePosRange 10 5
, LinePosRange 3 0
, LinePosRange 5 3
])
, testCase "Zero size last element"
$ Nothing @=? (lineLastIndex $
last $ lineIndices [ LinePosRange 10 5
, LinePosRange 3 0
])
]
, testGroup "Line Computations" line_computations
, testGroup "CursorPositioning"
[ testProperty "valid coordinates" prop_coordinates
]
]
prop_render_width f w =
let (rdata,img) = itemFieldRender (ItemFieldWidget "hi" f) def w h
h = 500
expected_width = if maxItemGroupLine f >= w
then maxLongGroupLine w f
else min (maxItemLine f) w
in w > 0 && w < 500 && cntItems (items f) > 0 ==>
expected_width == imageWidth img
prop_coordinates f w =
let pc = pos_coordinates f rdata
(Just (x,y)) = pc
numItems = cntItems $ items f
rdata = computeLinePosRanges w f
in if numItems == 0
then Nothing == pc
else x >= 0 && y >= 0
recover_lines lines = lines == (renderedLines $ RenderData 1 lines)
line_index_zero_start lines =
let li = lineIndices lines
line1 = head li
in if null lines
then null li
else if line1 == EmptyLine
then Nothing == lineFirstIndex line1
else Just 0 == lineFirstIndex line1
line_index_final_length lines =
let li = lineIndices lines
num = foldl (\a l -> a + lineWidth l) 0 lines
lineLast = last li
last_index = lineLastIndex lineLast
in if null lines
then [] == li
else if num == 0
then Nothing == last_index
else if lineLast == EmptyLine
then last_index == Nothing
else last_index == Just (num - 1)
line_computations = [ line_comp1
, line_comp2
, line_comp3
, line_comp4
, line_comp5
, line_comp6
, line_comp7
, line_comp8
, line_comp9
, line_comp10
, line_comp11
, line_comp12
]
line_comp1 = testCase "empty itemfield renderdata" $
RenderData 600 [] @=?
computeLinePosRanges 600 (ItemFld 0 [] [] Nothing)
line_comp2 = testProperty "renderdata width matches value passed or full width" $
\width itemfield ->
let RenderData w _ = computeLinePosRanges width itemfield
in w >= width
line_comp3 = testProperty "single Item per line RenderData" $
\i ->
let ttl = abs i
items = [Items ttl]
width = 10000 -- each items should be on a single line
field = newItemField items Nothing
RenderData w lprs = computeLinePosRanges width field
in and [ w == width
, length lprs == 1
, head lprs == LinePosRange 0 ttl
]
lineHdrLen (Items _) = 0
lineHdrLen (ItemGroup g i) = T.length g + 1 + lineHdrLen i
line_comp4 = testProperty "single Item set per line RenderData" $
\items ->
let ttl = cntItems items
width = 10000 -- each items should be on a single line
field = newItemField items Nothing
RenderData w lprs = computeLinePosRanges width field
in and [ length lprs == length items
, map lineStart lprs == map lineHdrLen items
]
sample_field1 = newItemField [ Items 13
, ItemGroup "g1" $ Items 15
, Items 0
, ItemGroup "g2" $ ItemGroup "grp3" $ ItemGroup "g4" $ Items 6
, ItemGroup "g2" $ ItemGroup "g3" $ Items 4
, Items 90
, ItemGroup "empty" $ Items 0
, Items 5
] Nothing
line_comp5 = testCase "Expected lineranges for width greater than all group titles" $
((renderedLines $ computeLinePosRanges 15 sample_field1)
@?=
sample_field1_linepos_width15)
sample_field1_linepos_width15 =
[ LinePosRange 0 13
, LinePosRange 3 (15 - 3), LinePosRange 3 3
, LinePosRange 0 0
, LinePosRange (3 + 5 + 3) (15 - 11), LinePosRange (3 + 5 + 3) 2
, LinePosRange (3 + 3) 4
, LinePosRange 0 15, LinePosRange 0 15, LinePosRange 0 15, LinePosRange 0 15
, {- + -} LinePosRange 0 15, LinePosRange 0 15
, LinePosRange 6 0
, LinePosRange 0 5
]
line_comp6 = testCase "Expected lineranges for width shorter than some group titles" $
((renderedLines $ computeLinePosRanges 10 sample_field1)
@?=
[ LinePosRange 0 13
, LinePosRange 3 14, LinePosRange 3 1
, LinePosRange 0 0
, LinePosRange (3 + 5 + 3) 6
, LinePosRange (3 + 3) 4
, LinePosRange 0 17, LinePosRange 0 17, LinePosRange 0 17, LinePosRange 0 17, LinePosRange 0 17, LinePosRange 0 5
, LinePosRange 6 0
, LinePosRange 0 5
])
line_comp7 = testCase "drawing no items output wide width tall" $
let width = 50
len = 500
itms = []
st8s = []
rdata = computeLinePosRanges width $ newItemField itms Nothing
redraw = redrawSt8Lines len itms st8s rdata
blanks n = (T.replicate n (T.singleton ' ') , itemBlankAttr)
noneline = [ blanks 14
, (T.pack "[None identified yet]", itemNoneMessageAttr)
, blanks 15
]
in [ noneline ] @=? redraw
line_comp8 = testCase "drawing expected output for wide width tall" $
let width = 50
len = 500
itms = items sample_field1
st8s = itemst8 sample_field1
rdata = computeLinePosRanges width $ newItemField itms Nothing
redraw = redrawSt8Lines len itms st8s rdata
freedot = (".",itemFreeAttr)
blank = (" ",itemBlankAttr)
expected = [replicate 13 freedot
,[("g1",itemHeaderAttr) ,blank] <>
replicate 15 freedot
,[]
,[("g2",itemHeaderAttr),blank
,("grp3",itemHeaderAttr),blank
,("g4",itemHeaderAttr),blank] <>
replicate 6 freedot
,[("g2",itemHeaderAttr),blank
,("g3",itemHeaderAttr),blank
,freedot,freedot,freedot,freedot]
, replicate 50 freedot
, replicate 40 freedot
,[("empty",itemHeaderAttr),blank]
,[freedot,freedot,freedot,freedot,freedot]
]
in expected @=? redraw
sample_field1_linepos_width50 =
[ LinePosRange 0 13
, LinePosRange 3 15
, LinePosRange 0 0
, LinePosRange (3 + 5 + 3) 6
, LinePosRange (3 + 3) 4
, LinePosRange 0 49, LinePosRange 0 41
, LinePosRange 6 0
, LinePosRange 0 5
]
line_comp9 = testCase "drawing expected output for medium width tall" $
let width = 15
len = 500
itms = items sample_field1
st8s = itemst8 sample_field1
rdata = computeLinePosRanges width $ newItemField itms Nothing
redraw = redrawSt8Lines len itms st8s rdata
freedot = (".",itemFreeAttr)
blank = (" ",itemBlankAttr)
expected = [replicate 13 freedot
,[("g1",itemHeaderAttr) ,blank] <>
replicate 12 freedot
,[(" ",itemBlankAttr)
,freedot,freedot,freedot]
,[]
,[("g2",itemHeaderAttr),blank
,("grp3",itemHeaderAttr),blank
,("g4",itemHeaderAttr),blank] <>
replicate 4 freedot
,[(" ",itemBlankAttr)
,(" ",itemBlankAttr)
,(" ",itemBlankAttr)
,freedot,freedot]
,[("g2",itemHeaderAttr),blank
,("g3",itemHeaderAttr),blank
,freedot,freedot,freedot,freedot]
, replicate 15 freedot
, replicate 15 freedot
, replicate 15 freedot
, replicate 15 freedot
, replicate 15 freedot
, replicate 15 freedot
,[("empty",itemHeaderAttr),blank]
,[freedot,freedot,freedot,freedot,freedot]
]
tl = 1
-- in (expected !! tl) @=? (redraw !! tl)
in expected @=? redraw
line_comp10 = testCase "empty but width is too short for none message" $
let width = 15
len = 500
itms = []
st8s = []
rdata = computeLinePosRanges width $ newItemField itms Nothing
redraw = redrawSt8Lines len itms st8s rdata
blanks n = (T.replicate n (T.singleton ' ') , itemBlankAttr)
noneline = [ (T.empty, itemBlankAttr)
, (T.pack
(take width "[None identified yet]")
, itemNoneMessageAttr)
, blanks 0
]
in [noneline] @=? redraw
line_comp11 = testCase "drawing Items 0 output wide width tall" $
let width = 50
len = 500
itms = [Items 0]
st8s = []
rdata = computeLinePosRanges width $ newItemField itms Nothing
redraw = redrawSt8Lines len itms st8s rdata
blanks n = (T.replicate n (T.singleton ' ') , itemBlankAttr)
msg = "[None identified yet]"
lpad = (width - (length msg + 1)) `div` 2
rpad = width - lpad - length msg
noneline = [ blanks lpad
, (T.pack msg, itemNoneMessageAttr)
, blanks rpad
]
in [noneline] @=? redraw
line_comp12 = testCase "drawing with not enough state elements assumes Free" $
let width = 50
len = 500
itms = [ItemGroup "a" $ Items 2, Items 4]
st8s = []
rdata = computeLinePosRanges width $ newItemField itms Nothing
redraw = redrawSt8Lines len itms st8s rdata
blank = (T.singleton ' ', itemBlankAttr)
freedot = (".",itemFreeAttr)
expected = [ [("a",itemHeaderAttr),blank,freedot,freedot]
, [ freedot, freedot, freedot, freedot ]
]
expLines = [LinePosRange 2 2, LinePosRange 0 4]
in (expected, expLines) @=? (redraw, renderedLines rdata)