-- This file is part of Goatee. -- -- Copyright 2014-2021 Bryan Gardiner -- -- Goatee is free software: you can redistribute it and/or modify -- it under the terms of the GNU Affero General Public License as published by -- the Free Software Foundation, either version 3 of the License, or -- (at your option) any later version. -- -- Goatee is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU Affero General Public License for more details. -- -- You should have received a copy of the GNU Affero General Public License -- along with Goatee. If not, see . module Game.Goatee.Lib.TypesTest (tests) where import Data.List (sort) import Game.Goatee.Lib.Types import Game.Goatee.Test.Common import Test.HUnit ((~:), (@=?), (@?=), Assertion, Test (TestList)) tests = "Game.Goatee.Lib.Types" ~: TestList [ expandCoordListTests , buildCoordListTests , starLinesTests , isStarPointTests , handicapStonesTests , simpleTextTests , cnotTests , lineTests ] expandCoordListTests = "expandCoordList" ~: TestList [ "works with an empty CoordList" ~: do [] @=? expandCoordList (coords []) [] @=? expandCoordList (coords' [] []) , "works for single points" ~: do [(1,2)] @=? expandCoordList (coord1 (1,2)) [(3,4), (1,2)] @=? expandCoordList (coords [(3,4), (1,2)]) let ten = [(i,i) | i <- [1..10]] ten @=? expandCoordList (coords ten) -- TODO Test that a 1x1 rectangle is rejected. , "works for a nx1 rect" ~: [(5,2), (5,3), (5,4)] @=? expandCoordList (coords' [] [((5,2), (5,4))]) , "works for a 1xn rect" ~: [(1,0), (1,1), (1,2), (1,3)] @=? expandCoordList (coords' [] [((1,0), (1,3))]) , "works for an mxn rect" ~: [(m,n) | m <- [2..5], n <- [3..7]] @=? expandCoordList (coords' [] [((2,3), (5,7))]) -- TODO Test that x0 > x1 || y0 > y1 is rejected. , "works with multiple rects" ~: [(0,0), (0,1), (0,2), (3,4), (4,4), (5,4)] @=? expandCoordList (coords' [] [((0,0), (0,2)), ((3,4), (5,4))]) , "concatenates single points and rects" ~: [(1,1), (0,0), (2,2), (2,3), (2,4)] @=? expandCoordList (coords' [(1,1), (0,0)] [((2,2), (2,4))]) ] buildCoordListTests = "buildCoordList" ~: TestList [ "handles the empty case" ~: assertSinglesAndRects [] [] [] , "handles one single" ~: assertSinglesAndRects [(0,1)] [] [(0,1)] , "handles multiple singles" ~: assertSinglesAndRects [(0,0), (1,1)] [] [(0,0), (1,1)] , "handles a small rect (1x2)" ~: assertSinglesAndRects [] [((0,1), (0,2))] [(0,1), (0,2)] , "handles a small square (2x2)" ~: assertSinglesAndRects [] [((1,1), (2,2))] [(x,y) | x <- [1..2], y <- [1..2]] , "handles a larger rect" ~: assertSinglesAndRects [] [((0,0), (2,4))] [(x,y) | x <- [0..2], y <- [0..4]] , "handles two rects" ~: assertSinglesAndRects [] [((0,1), (1,2)), ((3,0), (4,1))] [(0,1), (1,1), (0,2), (1,2), (3,0), (4,0), (3,1), (4,1)] , "handles rects and singles together" ~: assertSinglesAndRects [(0,0)] [((1,1), (2,2))] [(0,0), (1,1), (1,2), (2,1), (2,2)] , "handles five points together" ~: do assertCoords [(1,0), (0,1), (1,1), (0,2), (1,2)] assertCoords [(0,0), (1,0), (0,1), (1,1), (0,2)] assertCoords [(0,0), (1,0), (2,0), (0,1), (1,1)] assertCoords [(1,0), (2,0), (0,1), (1,1), (2,1)] , "handles a more complex case" ~: assertCoords [(3,0), (4,0), (3,1), (4,1), (0,2), (1,2), (2,2), (3,2), (4,2), (0,3), (1,3), (0,4), (1,4), (3,4), (4,4)] , "handles a diagonal pattern" ~: assertCoords [(0,0), (2,0), (4,0), (1,1), (3,1), (5,1), (2,2)] ] where -- | Asserts that the given grid of booleans parses to a 'CoordList' -- that has the expected single points (not necessarily in the same -- order), as well as the expected rectangles (not necessarily in the -- same order). assertSinglesAndRects :: [Coord] -> [(Coord, Coord)] -> [Coord] -> Assertion assertSinglesAndRects expectedSingles expectedRects input = coords' expectedSingles expectedRects @=? buildCoordList input -- | Asserts that the set of points returned from applying -- 'buildCoordList' to the given grid of booleans is equal to -- the given set of points. assertCoords :: [Coord] -> Assertion assertCoords input = sort input @=? sort (expandCoordList $ buildCoordList input) starLinesTests = "starLines" ~: TestList [ "knows 9x9 boards" ~: Just [2, 4, 6] @=? starLines 9 9 , "knows 13x13 boards" ~: Just [3, 6, 9] @=? starLines 13 13 , "knows 19x19 boards" ~: Just [3, 9, 15] @=? starLines 19 19 , "doesn't know 13x19" ~: Nothing @=? starLines 13 19 , "doesn't know 10x10" ~: Nothing @=? starLines 10 10 ] isStarPointTests = "isStarPoint" ~: TestList [ "only knows correct star points on a 9x9 board" ~: let expected = [(x, y) | x <- [2, 4, 6], y <- [2, 4, 6]] actual = actualStarPoints 9 9 in expected @=?* actual , "only knows correct star points on a 13x13 board" ~: let expected = [(x, y) | x <- [3, 6, 9], y <- [3, 6, 9]] actual = actualStarPoints 13 13 in expected @=?* actual , "only knows correct star points on a 19x19 board" ~: let expected = [(x, y) | x <- [3, 9, 15], y <- [3, 9, 15]] actual = actualStarPoints 19 19 in expected @=?* actual , "knows no star poinst on a 5x1 board" ~: [] @=? actualStarPoints 5 1 , "knows no star points on a 15x15 board" ~: [] @=? actualStarPoints 15 15 , "knows no star points on a 20x20 board" ~: [] @=? actualStarPoints 20 20 ] where actualStarPoints width height = map fst $ filter snd [((x, y), isStarPoint width height x y) | x <- [0..width-1], y <- [0..height-1]] handicapStonesTests = "handicapStones" ~: TestList [ "returns nothing for invalid handicaps" ~: do Nothing @=? handicapStones 9 9 (-1) Nothing @=? handicapStones 9 9 10 Nothing @=? handicapStones 4 4 25 , "9x9 0 handicap" ~: assertHandicap 9 9 0 $ Just [] , "9x9 1 handicap" ~: assertHandicap 9 9 1 $ Just [] , "9x9 2 handicap" ~: assertHandicap 9 9 2 $ Just [(2,6), (6,2)] , "9x9 3 handicap" ~: assertHandicap 9 9 3 $ Just [(2,6), (6,2), (6,6)] , "9x9 4 handicap" ~: assertHandicap 9 9 4 $ Just [(2,2), (2,6), (6,2), (6,6)] , "9x9 5 handicap" ~: assertHandicap 9 9 5 $ Just [(2,2), (2,6), (4,4), (6,2), (6,6)] , "9x9 6 handicap" ~: assertHandicap 9 9 6 $ Just [(2,2), (2,4), (2,6), (6,2), (6,4), (6,6)] , "9x9 7 handicap" ~: assertHandicap 9 9 7 $ Just [(2,2), (2,4), (2,6), (4,4), (6,2), (6,4), (6,6)] , "9x9 8 handicap" ~: assertHandicap 9 9 8 $ Just [(2,2), (2,4), (2,6), (4,2), (4,6), (6,2), (6,4), (6,6)] , "9x9 9 handicap" ~: assertHandicap 9 9 9 $ Just [(2,2), (2,4), (2,6), (4,2), (4,4), (4,6), (6,2), (6,4), (6,6)] , "13x13 0 handicap" ~: assertHandicap 13 13 0 $ Just [] , "13x13 1 handicap" ~: assertHandicap 13 13 1 $ Just [] , "13x13 2 handicap" ~: assertHandicap 13 13 2 $ Just [(3,9), (9,3)] , "13x13 3 handicap" ~: assertHandicap 13 13 3 $ Just [(3,9), (9,3), (9,9)] , "13x13 4 handicap" ~: assertHandicap 13 13 4 $ Just [(3,3), (3,9), (9,3), (9,9)] , "13x13 5 handicap" ~: assertHandicap 13 13 5 $ Just [(3,3), (3,9), (6,6), (9,3), (9,9)] , "13x13 6 handicap" ~: assertHandicap 13 13 6 $ Just [(3,3), (3,6), (3,9), (9,3), (9,6), (9,9)] , "13x13 7 handicap" ~: assertHandicap 13 13 7 $ Just [(3,3), (3,6), (3,9), (6,6), (9,3), (9,6), (9,9)] , "13x13 8 handicap" ~: assertHandicap 13 13 8 $ Just [(3,3), (3,6), (3,9), (6,3), (6,9), (9,3), (9,6), (9,9)] , "13x13 9 handicap" ~: assertHandicap 13 13 9 $ Just [(3,3), (3,6), (3,9), (6,3), (6,6), (6,9), (9,3), (9,6), (9,9)] , "19x19 0 handicap" ~: assertHandicap 19 19 0 $ Just [] , "19x19 1 handicap" ~: assertHandicap 19 19 1 $ Just [] , "19x19 2 handicap" ~: assertHandicap 19 19 2 $ Just [(3,15), (15,3)] , "19x19 3 handicap" ~: assertHandicap 19 19 3 $ Just [(3,15), (15,3), (15,15)] , "19x19 4 handicap" ~: assertHandicap 19 19 4 $ Just [(3,3), (3,15), (15,3), (15,15)] , "19x19 5 handicap" ~: assertHandicap 19 19 5 $ Just [(3,3), (3,15), (9,9), (15,3), (15,15)] , "19x19 6 handicap" ~: assertHandicap 19 19 6 $ Just [(3,3), (3,9), (3,15), (15,3), (15,9), (15,15)] , "19x19 7 handicap" ~: assertHandicap 19 19 7 $ Just [(3,3), (3,9), (3,15), (9,9), (15,3), (15,9), (15,15)] , "19x19 8 handicap" ~: assertHandicap 19 19 8 $ Just [(3,3), (3,9), (3,15), (9,3), (9,15), (15,3), (15,9), (15,15)] , "19x19 9 handicap" ~: assertHandicap 19 19 9 $ Just [(3,3), (3,9), (3,15), (9,3), (9,9), (9,15), (15,3), (15,9), (15,15)] ] where assertHandicap width height handicap maybeExpectedStones = case (handicapStones width height handicap, maybeExpectedStones) of (Just actualStones, Just expectedStones) -> actualStones @?=* expectedStones (actual, _) -> actual @?= maybeExpectedStones simpleTextTests = "SimpleText" ~: TestList [ "accepts the empty string" ~: "" @=? fromSimpleText (toSimpleText "") , "passes through strings without newlines" ~: do "Hello." @=? fromSimpleText (toSimpleText "Hello.") "Bad for B." @=? fromSimpleText (toSimpleText "Bad for B.") "[4k?]" @=? fromSimpleText (toSimpleText "[4k?]") printableAsciiChars @=? fromSimpleText (toSimpleText printableAsciiChars) , "converts newlines to spaces" ~: do " " @=? fromSimpleText (toSimpleText "\n") "Hello, world." @=? fromSimpleText (toSimpleText "Hello,\nworld.") "Hello, world." @=? fromSimpleText (toSimpleText "Hello, \n world.") " Hello, world. " @=? fromSimpleText (toSimpleText "\nHello, world.\n") ] cnotTests = "cnot" ~: TestList [ "changes Black to White" ~: White @=? cnot Black , "changes White to Black" ~: Black @=? cnot White ] lineTests = "Line" ~: TestList [ "Eq instance" ~: TestList [ "Line a b == Line a b" ~: Line (1,2) (3,4) @=? Line (1,2) (3,4) , "Line a b == Line b a" ~: Line (1,2) (3,4) @=? Line (3,4) (1,2) , "Line a b /= Line c b" ~: do Line (1,2) (3,4) @/=? Line (0,2) (3,4) Line (1,2) (3,4) @/=? Line (1,0) (3,4) , "Line a b /= Line a c" ~: do Line (1,2) (3,4) @/=? Line (1,2) (0,4) Line (1,2) (3,4) @/=? Line (1,2) (3,0) ] , "lineToPair" ~: ((10,2), (5,7)) @=? lineToPair (Line (10,2) (5,7)) ]