table-layout-1.0.0.2: test-suite/TestSpec.hs
module TestSpec
( spec
) where
-- TODO idempotency of fitting CMIs
import qualified Data.Text as T
import Data.Maybe (listToMaybe)
import Data.List (isInfixOf)
import Text.DocLayout (charWidth)
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck
import Text.Layout.Table
import Text.Layout.Table.Cell (Cell(..), CutAction(..), CutInfo(..), applyCutInfo, determineCutAction, determineCuts, dropLeft, dropRight, viewRange, buildCellMod)
import Text.Layout.Table.Cell.WideString (WideString(..), WideText(..))
import Text.Layout.Table.Spec.AlignSpec
import Text.Layout.Table.Spec.CutMark
import Text.Layout.Table.Spec.OccSpec
import Text.Layout.Table.Spec.Position
import Text.Layout.Table.Spec.RowGroup
import Text.Layout.Table.Primitives.Basic
import Text.Layout.Table.Primitives.AlignInfo
import Text.Layout.Table.Justify
import Text.Layout.Table.Cell.Formatted
-- A newtype wrapper around 'String', allowing an 'Arbitrary' instance which
-- guarantees the width of each character is exactly one.
newtype NonControlASCIIString = NonControlASCIIString String
deriving (Eq, Ord, Show)
-- Generate only non-control characters within the ASCII range
-- (see https://en.wikipedia.org/wiki/Control_character).
instance Arbitrary NonControlASCIIString where
arbitrary = NonControlASCIIString <$> listOf (chooseEnum ('\32', '\126'))
shrink (NonControlASCIIString xs) = NonControlASCIIString <$> shrink xs
instance Arbitrary (Position o) where
arbitrary = elements [Start, End, Center]
shrink Center = [Start, End]
shrink End = [Start]
shrink Start = []
instance Arbitrary AlignSpec where
arbitrary = oneof [pure noAlign, charAlign <$> arbitrary]
shrink NoAlign = []
shrink _ = [NoAlign]
forAllAlign :: Testable prop => (AlignSpec -> prop) -> Property
forAllAlign = forAllShrinkShow arbitrary shrink showAlign . (. maybe NoAlign charAlign)
where
showAlign Nothing = "NoAlign"
showAlign (Just c) = "align at " ++ show c
instance Arbitrary CutMark where
arbitrary = elements [noCutMark, def, customCM, unevenCM]
shrink x | x == noCutMark = []
| x == def = [noCutMark]
| otherwise = [noCutMark, def]
customCM, unevenCM :: CutMark
customCM = doubleCutMark "<.." "..>"
unevenCM = doubleCutMark "<" "-->"
occS = predOccSpec (== ':')
hposG = elements [left, center, right]
-- Arbitrary instance of WideString needs to exclude combining characters at the start
instance Arbitrary WideString where
arbitrary = fmap WideString $ arbitrary `suchThat` (maybe True ((0 /=) . charWidth) . listToMaybe)
shrink (WideString x) = map WideString $ shrink x
spec :: Spec
spec = do
describe "fill" $ do
describe "fillLeft" $
it "ex1" $ fillLeft 4 "ab" `shouldBe` " ab"
describe "fillRight" $
it "ex1" $ fillRight 4 "ab" `shouldBe` "ab "
describe "fillCenter" $
it "ex1" $ fillCenter 4 "ab" `shouldBe` " ab "
describe "mark" $ do
prop "left mark does not change length" $ \s -> length (applyMarkLeftWith customCM s) `shouldBe` length s
prop "right mark does not change length" $ \s -> length (applyMarkRightWith customCM s) `shouldBe` length s
describe "fit" $ do
describe "fitRightWith" $ do
let fitRight = fitRightWith customCM
it "ex1" $ fitRight 4 "12345678" `shouldBe` "1..>"
describe "fitLeftWith" $ do
let fitLeft = fitLeftWith customCM
it "ex1" $ fitLeft 4 "12345678" `shouldBe` "<..8"
describe "fitCenterWith" $ do
let fitCenter = fitCenterWith customCM
it "ex1" $ fitCenter 7 "12345678" `shouldBe` "<..5678"
it "ex1" $ fitCenter 6 "12345678" `shouldBe` "<....>"
-- TODO implement test cases
-- describe "ColModInfo" $ do
-- it "ensureWidthCMI" $
describe "pad" $ do
prop "left" propPadLeft
prop "right" propPadRight
prop "center" propPadCenter
describe "trim" $ do
prop "left" $ propTrim left noCutMark
prop "left with cut mark" $ propTrim left customCM
prop "right" $ propTrim right noCutMark
prop "right with cut mark" $ propTrim right customCM
prop "center" $ propTrim center noCutMark
prop "center with cut mark" $ propTrim center customCM
describe "trimmed cut mark" $ do
let trim' p = buildCellMod customCM $ trim p customCM 1 "aa"
it "right" $ trim' left `shouldBe` ">"
it "left" $ trim' right `shouldBe` "<"
describe "trimOrPad" $ do
let trimOrPad' p cm n s = buildCellMod cm $ trimOrPad p cm n s
let pad' p n s = buildCellMod noCutMark $ pad p n s
prop "pad" $ forAll hposG $ \p s (Positive (Small n)) ->
length (s :: String) > n || trimOrPad' p noCutMark n s == (pad' p n s :: String)
it "left" $ trimOrPad' left customCM 5 "1234567890" `shouldBe` "12..>"
it "right" $ trimOrPad' right customCM 5 "1234567890" `shouldBe` "<..90"
it "center" $ trimOrPad' center customCM 8 "1234567890" `shouldBe` "<..56..>"
it "center one sided" $ trimOrPad' center customCM 9 "1234567890" `shouldBe` "<..567890"
describe "align" $ do
let ai = deriveAlignInfo occS "abc:42"
let align' s = buildCellMod noCutMark (align occS ai s) :: String
it "ex1" $ align' "c:4" `shouldBe` " c:4 "
it "ex2" $ align' "x" `shouldBe` " x "
it "ex3" $ align' ":x" `shouldBe` " :x "
describe "determineCuts" $ do
describe "cases" $ do
it "view entails the cell" $ determineCuts 0 8 2 6 `shouldBe` SidesCI (FillCA 2) (FillCA 2)
it "cell entails the view" $ determineCuts 2 6 0 8 `shouldBe` SidesCI (CutCA 2) (CutCA 2)
it "disjunct and view left" $ determineCuts 0 2 4 6 `shouldBe` MarkRightCI
it "disjunct and view right" $ determineCuts 4 6 0 2 `shouldBe` MarkLeftCI
it "one side cut and view left" $ determineCuts 0 4 2 6 `shouldBe` SidesCI (FillCA 2) (CutCA 2)
it "one side cut and view right" $ determineCuts 2 6 0 4 `shouldBe` SidesCI (CutCA 2) (FillCA 2)
describe "bound tests" $ do
it "disjunct and view right" $ determineCuts 1 2 0 1 `shouldBe` MarkLeftCI
it "disjunct and view left" $ determineCuts 0 1 1 2 `shouldBe` MarkRightCI
describe "determineCutAction" $ do
it "actual width has less than required" $ determineCutAction 8 4 `shouldBe` FillCA 4
it "actual width has exactly the required amount" $ determineCutAction 8 8 `shouldBe` NoneCA
it "actual width has more than required" $ determineCutAction 4 6 `shouldBe` CutCA 2
describe "applyCutInfo" $ do
let apply ci = buildCellMod customCM (applyCutInfo ci customCM 5 11 "abcde:12345") :: String
apply2 ci s = buildCellMod customCM (applyCutInfo ci customCM 5 (length s) s) :: String
apply3 ci n s = buildCellMod customCM (applyCutInfo ci customCM n (length s) s) :: String
apply4 ca s = buildCellMod unevenCM (applyCutInfo ca unevenCM 5 (length s) s) :: String
-- "<...>"
it "double cut" $ apply (SidesCI (CutCA 3) (CutCA 3)) `shouldBe` "<...>"
it "left cut" $ apply (SidesCI (CutCA 6) NoneCA) `shouldBe` "<..45"
it "left cut and pad" $ apply (SidesCI (CutCA 7) (FillCA 1)) `shouldBe` "<..5 "
it "right cut" $ apply (SidesCI NoneCA (CutCA 6)) `shouldBe` "ab..>"
it "right cut and pad" $ apply (SidesCI (FillCA 1) (CutCA 7)) `shouldBe` " a..>"
it "double pad" $ apply2 (SidesCI (FillCA 1) (FillCA 1)) "abc" `shouldBe` " abc "
it "no action" $ apply2 (SidesCI NoneCA NoneCA) "abcde" `shouldBe` "abcde"
it "mark right 1" $ apply3 MarkRightCI 1 "" `shouldBe` ">"
it "mark right 2" $ apply3 MarkRightCI 2 "" `shouldBe` ".>"
it "mark right 3" $ apply3 MarkRightCI 4 "a" `shouldBe` " ..>"
it "mark left 1" $ apply3 MarkLeftCI 1 "" `shouldBe` "<"
it "mark left 2" $ apply3 MarkLeftCI 2 "" `shouldBe` "<."
it "mark left 3" $ apply3 MarkLeftCI 4 "a" `shouldBe` "<.. "
it "uneven mark left" $ apply4 MarkLeftCI "12345" `shouldBe` "< "
it "uneven mark right" $ apply4 MarkRightCI "12345" `shouldBe` " -->"
describe "viewRange" $ do
-- " : "
-- " "
it "left" $ viewRange left 4 5 5 `shouldBe` (0, 4)
-- " : "
-- " "
-- 01234567891
it "right" $ viewRange right 4 5 5 `shouldBe` (7, 11)
-- " : "
-- " " (left-biased centering)
-- " " (right-biased-centering)
-- (l + r + 1 - n) / 2 = (5 + 5 + 1 - 4) / 2 = 7 / 2 = 3 rem 1
it "center" $ viewRange center 4 5 5 `shouldBe` (4, 8)
describe "alignFixed" $ do
-- 5 spaces on each side.
let ai = deriveAlignInfo occS " : "
alignFixed' p l = buildCellMod customCM . alignFixed p customCM l occS ai
ai2 = deriveAlignInfo occS " : "
alignFixed2' p l = buildCellMod customCM . alignFixed p customCM l occS ai2
it "left 1" $ alignFixed' left 6 "ab:42" `shouldBe` " ..>"
it "left 2" $ alignFixed' left 6 "abcd:42" `shouldBe` " ab..>"
it "left 3" $ alignFixed' left 5 "32" `shouldBe` " 32"
-- " : "
-- "ab:1234"
-- "<..34 "
it "right 1" $ alignFixed' right 6 "ab:1234" `shouldBe` "<..34 "
it "right 2" $ alignFixed' right 6 "ab:12" `shouldBe` "<.. "
-- ensure left-biased centering:
-- aligned to full length: " abcd:12 "
-- right-biased centering: "bcd:12"
-- left-biased centering: "cd:12 "
it "center 1" $ alignFixed' center 6 "abcd:12" `shouldBe` "<..12 "
-- use same string position: "ab:12 "
it "center 2" $ alignFixed' center 6 "ab:12" `shouldBe` "ab:12 "
-- ensure left-biased centering:
-- aligned to full length: " abcd:12 "
-- right-biased centering: " abcd:"
-- left-biased centering: "abcd:1"
it "center 3" $ alignFixed2' center 6 "abcd:12" `shouldBe` "abc..>"
-- use same string position: " ab:1"
it "center 4" $ alignFixed2' center 6 "ab:12" `shouldBe` " a..>"
-- TODO add test cases for all combinations of lengths
-- (i.e.: i mod 2 = 1, i mod 2 = 0, l + r mod 2 = 0, l + r mod 2 = 1)
prop "alignFixed length" $ forAll hposG $ \p s (Positive (Small n)) ->
length (alignFixed' p n (s :: String) :: String) `shouldBe` n
describe "text justification" $ do
describe "fitWords" $ do
it "single word" $ fitWords 5 ["test"] `shouldBe` [Line 4 1 ["test"]]
it "two words" $ fitWords 3 ["a", "b"] `shouldBe` [Line 3 2 ["a", "b"]]
it "breaking words" $
fitWords 2 ["a", "b"] `shouldBe` [Line 1 1 ["a"], Line 1 1 ["b"]]
it "breaking words, multiple words per line" $
fitWords 3 ["a", "b", "c", "d"] `shouldBe` [Line 3 2 ["a", "b"], Line 3 2 ["c", "d"]]
describe "justify" $ do
it "break lines" $ justify 3 ["not", "now"] `shouldBe` ["not", "now"]
it "words in right order" $ justify 10 ["not", "now"] `shouldBe` ["not now"]
it "" $ justify 3 ["a", "b", "c", "d", "e"] `shouldBe` ["a b", "c d", "e"]
describe "concatPadLine" $ do
it "even" $ concatPadLine 9 (Line 9 3 ["It", "is", "on"]) `shouldBe` "It is on"
it "odd" $ concatPadLine 13 (Line 11 4 ["It", "is", "on", "us"]) `shouldBe` "It is on us"
describe "grid" . modifyMaxSuccess (const 1000) $ do
let wide = "A long string"
narrow = "Short"
describe "expand" $ do
prop "for String" $ propExpand id noAlign
prop "for WideString" $ propExpand WideString noAlign
describe "fixed" $ do
prop "for String" $ propFixed id noAlign
prop "for WideString" $ propFixed WideString noAlign
describe "expandUntil" $ do
prop "for String" $ propExpandUntil id noAlign
prop "for WideString" $ propExpandUntil WideString noAlign
let col pos i = column (expandUntil i) pos noAlign noCutMark
it "when dropping from the right" $
grid [col left 8] [[wide], [narrow]] `shouldBe` [["A long s"], ["Short "]]
it "when dropping from the left" $
grid [col right 8] [[wide], [narrow]] `shouldBe` [["g string"], [" Short"]]
describe "fixedUntil" $ do
prop "for String" $ propFixedUntil id noAlign
prop "for WideString" $ propFixedUntil WideString noAlign
describe "expandBetween" $ do
prop "for String" $ propExpandBetween id noAlign
prop "for WideString" $ propExpandBetween WideString noAlign
describe "formatted text" $ do
let exampleF = formatted "XXX" (plain "Hello" <> formatted "Z" (plain "there") "W") "YYY"
describe "rendering" $ do
it "plain" $ buildCell (plain "Hello") `shouldBe` "Hello"
it "formatted" $ buildCell (formatted "XXX" (plain "Hello") "YYY") `shouldBe` "XXXHelloYYY"
it "concatenation of formatted" $ buildCell exampleF `shouldBe` "XXXHelloZthereWYYY"
describe "dropLeft" $ do
it "drops 0" $ buildCell (dropLeft 0 exampleF) `shouldBe` "XXXHelloZthereWYYY"
it "drops 3" $ buildCell (dropLeft 3 exampleF) `shouldBe` "XXXloZthereWYYY"
it "drops 8" $ buildCell (dropLeft 8 exampleF) `shouldBe` "XXXZreWYYY"
it "drops 20" $ buildCell (dropLeft 20 exampleF) `shouldBe` "XXXZWYYY"
describe "dropRight" $ do
it "drops 0" $ buildCell (dropRight 0 exampleF) `shouldBe` "XXXHelloZthereWYYY"
it "drops 3" $ buildCell (dropRight 3 exampleF) `shouldBe` "XXXHelloZthWYYY"
it "drops 8" $ buildCell (dropRight 8 exampleF) `shouldBe` "XXXHeZWYYY"
it "drops 20" $ buildCell (dropRight 20 exampleF) `shouldBe` "XXXZWYYY"
describe "visibleLength" $ do
it "plain" $ visibleLength (plain "Hello") `shouldBe` 5
it "formatted" $ visibleLength exampleF `shouldBe` 10
describe "measureAlignment" $ do
it "finds e" $ measureAlignmentAt 'e' exampleF `shouldBe` AlignInfo 1 (Just 8)
it "finds h" $ measureAlignmentAt 'h' exampleF `shouldBe` AlignInfo 6 (Just 3)
it "doesn't find q" $ measureAlignmentAt 'q' exampleF `shouldBe` AlignInfo 10 Nothing
describe "wide string" $ do
let wide = WideString "㐀㐁㐂"
narrow = WideString "Bien sûr!"
describe "buildCell" $ do
prop "agrees for ascii strings" $ \(NonControlASCIIString x) -> buildCell (WideString x) `shouldBe` x
it "renders double width" $ buildCell wide `shouldBe` "㐀㐁㐂"
it "renders zero width" $ buildCell narrow `shouldBe` "Bien sûr!"
describe "visibleLength" $ do
prop "agrees for ascii strings" $ \(NonControlASCIIString x) -> visibleLength (WideString x) `shouldBe` visibleLength x
it "detects double width" $ visibleLength wide `shouldBe` 6
it "detects zero width" $ visibleLength narrow `shouldBe` 9
describe "measureAlignment" $ do
prop "agrees for ascii strings" $ \(NonControlASCIIString x) -> measureAlignmentAt 'e' (WideString x) `shouldBe` measureAlignment (=='e') x
it "detects double width" $ measureAlignmentAt '㐁' wide `shouldBe` AlignInfo 2 (Just 2)
it "fails to detect" $ measureAlignmentAt 'a' wide `shouldBe` AlignInfo 6 Nothing
it "detects zero width after" $ measureAlignmentAt 'n' narrow `shouldBe` AlignInfo 3 (Just 5)
it "detects zero width before" $ measureAlignmentAt 'r' narrow `shouldBe` AlignInfo 7 (Just 1)
describe "dropLeft" $ do
prop "agrees for ascii strings" $ \(Small n) (NonControlASCIIString x) -> buildCell (dropLeft n (WideString x)) `shouldBe` (buildCell (dropLeft n x) :: String)
describe "on wide characters" $ do
it "drops 1 character of double width" $ buildCell (dropLeft 2 wide) `shouldBe` "㐁㐂"
it "drops 2 characters of double width and adds a space" $ buildCell (dropLeft 3 wide) `shouldBe` " 㐂"
describe "on narrow characters" $ do
it "drops combining characters with their previous" $ buildCell (dropLeft 7 narrow) `shouldBe` "r!"
it "drops combining characters after a dropped wide character which overshoots" $ buildCell (dropLeft 1 (WideString "㐀̈㐁")) `shouldBe` " 㐁"
describe "dropRight" $ do
prop "agrees for ascii strings" $ \(Small n) (NonControlASCIIString x) -> buildCell (dropRight n (WideString x)) `shouldBe` (buildCell (dropRight n x) :: String)
describe "on wide characters" $ do
it "drops 1 character of double width" $ buildCell (dropRight 2 wide) `shouldBe` "㐀㐁"
it "drops 2 characters of double width and adds a space" $ buildCell (dropRight 3 wide) `shouldBe` "㐀 "
describe "on narrow characters" $ do
it "drops a combining character for free" $ buildCell (dropRight 3 narrow) `shouldBe` "Bien s"
it "does not drop a combining character without their previous" $ buildCell (dropRight 2 narrow) `shouldBe` "Bien sû"
describe "wide text" $ do
describe "buildCell" $ do
prop "gives the same result as wide string" $ \x -> buildCell (WideText $ T.pack x) `shouldBe` x
describe "visibleLength" $ do
prop "gives the same result as wide string" $ \x -> visibleLength (WideText $ T.pack x) `shouldBe` visibleLength (WideString x)
describe "measureAlignment" $ do
prop "gives the same result as wide string" $ \x -> measureAlignment (=='e') (WideText $ T.pack x) `shouldBe` measureAlignment (=='e') (WideString x)
describe "dropLeft" $ do
prop "gives the same result as wide string" $ \(Small n) x -> buildCell (dropLeft n . WideText $ T.pack x) `shouldBe` (buildCell . dropLeft n $ WideString x :: String)
describe "dropRight" $ do
prop "gives the same result as wide string" $ \(Small n) x -> buildCell (dropRight n . WideText $ T.pack x) `shouldBe` (buildCell . dropRight n $ WideString x :: String)
describe "row groups" $ do
describe "rowGroupShape" $ do
it "multi" $ rowGroupShape (MultiRowGroup [[0, 1], [2, 3]]) `shouldBe` [(), ()]
it "multi only first row 1" $ rowGroupShape (MultiRowGroup [[0, 1], [2, 3, 4]]) `shouldBe` [(), ()]
it "multi only first row 2" $ rowGroupShape (MultiRowGroup [[0, 1], []]) `shouldBe` [(), ()]
it "multi empty" $ rowGroupShape (MultiRowGroup []) `shouldBe` []
it "singleton empty" $ rowGroupShape (SingletonRowGroup []) `shouldBe` []
it "singleton" $ rowGroupShape (SingletonRowGroup [1, 2]) `shouldBe` [(), ()]
it "nullable empty" $ rowGroupShape (NullableRowGroup []) `shouldBe` []
it "nullable one element" $ rowGroupShape (NullableRowGroup [[Just 4]]) `shouldBe` [()]
it "nullable but no null" $ rowGroupShape (NullableRowGroup [[Just 1, Just 2]]) `shouldBe` [(), ()]
it "nullable mixed" $ rowGroupShape (NullableRowGroup [[Just 1, Nothing, Nothing]]) `shouldBe` [(), (), ()]
let rgs = [rg1, rg2, rg3] :: [RowGroup Int]
rg1 = MultiRowGroup [[0, 1, 2], [3, 4, 5]]
rg2 = SingletonRowGroup [6, 7, 8]
rg3 = NullableRowGroup [[Nothing, Just 9, Nothing]]
it "transposeRowGroups" $
transposeRowGroups rgs `shouldBe` [ SegmentedColumn [ColumnSegment [0, 3], SingleValueSegment 6, NullableColumnSegment [Nothing]]
, SegmentedColumn [ColumnSegment [1, 4], SingleValueSegment 7, NullableColumnSegment [Just 9]]
, SegmentedColumn [ColumnSegment [2, 5], SingleValueSegment 8, NullableColumnSegment [Nothing]]
]
describe "mapRowGroupColumns" $ do
let mappers = [(negate 1, (+ 1)), (0, (* 2)), (negate 2, (`div` 2))]
it "multi" $ mapRowGroupColumns mappers rg1 `shouldBe` [[1, 2, 1], [4, 8, 2]]
it "singleton" $ mapRowGroupColumns mappers rg2 `shouldBe` [[7, 14, 4]]
it "nullable" $ mapRowGroupColumns mappers rg3 `shouldBe` [[negate 1, 18, negate 2]]
where
customCM = doubleCutMark "<.." "..>"
unevenCM = doubleCutMark "<" "-->"
occS = predOccSpec (== ':')
hposG = elements [left, center, right]
propPadLeft :: String -> Positive (Small Int) -> Bool
propPadLeft s (Positive (Small n)) =
let len = length s
padded = buildCellMod noCutMark $ pad left n s
in len >= n || (take len padded == s && all (== ' ') (drop len padded))
propPadRight :: String -> Positive (Small Int) -> Bool
propPadRight s (Positive (Small n)) =
let len = length s
padded = buildCellMod noCutMark $ pad right n s
in len >= n || (drop (n - len) padded == s
&& all (== ' ') (take (n - len) padded))
propPadCenter :: String -> Positive (Small Int) -> Bool
propPadCenter s (Positive (Small n)) =
let len = length s
padded = buildCellMod noCutMark $ pad center n s
(q, r) = (n - len) `divMod` 2
trimLeft = drop q padded
in len >= n || (all (== ' ') (take q padded) && take len trimLeft == s
&& drop len trimLeft == replicate (q + r) ' ')
propTrim :: Position o -> CutMark -> String -> Positive (Small Int) -> Bool
propTrim pos cm s (Positive (Small n)) =
let len = length s
trimmed = buildCellMod cm (trim pos cm n s) :: String
cutMarkTooLong = case pos of
Start -> n < length (rightMark cm)
End -> n < length (leftMark cm)
Center -> n < length (rightMark cm) + length (leftMark cm)
in cutMarkTooLong || if len > n
then length trimmed == n
else trimmed == s
gridPropHelper :: (Cell a, Testable prop) => ColSpec -> (String -> a) -> [a] -> (Int -> prop) -> Property
gridPropHelper col f xs isRightLength =
allRowsHaveRightLength (grid [col] $ map pure xs) .||. anyRowHasPathologicalUnicode xs
where
allRowsHaveRightLength = conjoin . map (conjoin . map (isRightLength . visibleLength . f))
anyRowHasPathologicalUnicode = disjoin . map (hasPathologicalUnicode . buildCell)
propExpand :: Cell a => (String -> a) -> AlignSpec -> Position H -> CutMark
-> NonEmptyList a -> Property
propExpand f align pos cm (NonEmpty xs) =
let col = column expand pos align cm
len = maximum $ map visibleLength xs
in gridPropHelper col f xs (=== len)
propFixed :: Cell a => (String -> a) -> AlignSpec -> Position H -> CutMark
-> Positive (Small Int) -> NonEmptyList a -> Property
propFixed f align pos cm (Positive (Small n)) (NonEmpty xs) =
let col = column (fixed n) pos align cm
in gridPropHelper col f xs (=== n)
propExpandUntil :: Cell a => (String -> a) -> AlignSpec -> Position H -> CutMark
-> Positive (Small Int) -> NonEmptyList a -> Property
propExpandUntil f align pos cm (Positive (Small n)) (NonEmpty xs) =
let col = column (expandUntil n) pos align cm
len = maximum $ map visibleLength xs
in cover 10 (len <= n) "shorter than limit" . cover 10 (len > n) "longer than limit" $
gridPropHelper col f xs (=== min len n)
propFixedUntil :: Cell a => (String -> a) -> AlignSpec -> Position H -> CutMark
-> Positive (Small Int) -> NonEmptyList a -> Property
propFixedUntil f align pos cm (Positive (Small n)) (NonEmpty xs) =
let col = column (fixedUntil n) pos align cm
len = maximum $ map visibleLength xs
in cover 10 (len <= n) "shorter than limit" . cover 10 (len > n) "longer than limit" $
gridPropHelper col f xs (=== max len n)
propExpandBetween :: Cell a => (String -> a) -> AlignSpec -> Position H -> CutMark
-> Positive (Small Int) -> Positive (Small Int) -> NonEmptyList a -> Property
propExpandBetween f align pos cm (Positive (Small m)) (Positive (Small n)) (NonEmpty xs) =
let col = column (expandBetween (min m n) (max m n)) pos align cm
len = maximum $ map visibleLength xs
b = min m n
t = max m n
in cover 10 (len <= b) "shorter than limit" . cover 10 (len > t) "longer than limit" .
cover 10 (len > b && len <= t) "between limits" $
gridPropHelper col f xs (=== max b (min t len))
-- A keypad character followed by a zero-width join or variation selector
-- will cause tests to fail, but this is pathological Unicode and failure
-- is acceptable.
hasPathologicalUnicode :: String -> Bool
hasPathologicalUnicode test = or $ do
k <- '#' : '*' : ['0'..'9']
v <- ['\8205', '\65039']
return $ [k, v] `isInfixOf` test
measureAlignmentAt :: Cell a => Char -> a -> AlignInfo
measureAlignmentAt c = measureAlignment (== c)