import Datatypes import VM import Data.Hashable (hash, Hashable(..)) import Data.Set (Set) import qualified Data.Set as Set import Test.QuickCheck test :: (Cell -> Cell) -> [Bool] test f = [f (0,3) == (2,5), f (1,3) == (3, 6), f (2,3) == (3,7), f (3, 3) == (4,8), f (2, 4) == (2,7)] test2 :: (Cell -> Cell) -> [Bool] test2 f = [f (2,5) == (3,6), f (3,6) == (2, 7), f (2,7) == (1,7), f (1, 7) == (1,6), f (1, 6) == (1,5), f (1, 5) == (2, 5)] deepCheck p = quickCheckWith (stdArgs { maxSuccess = 10000 }) p testTutto = do deepCheck (\pivot cell -> let r2 = rotateCell pivot in (r2 . r2 . r2 . r2 . r2 . r2) cell == cell) deepCheck (\pivot cell -> cell == counterRotateCell pivot (rotateCell pivot cell)) deepCheck (\pivot cell -> cell == counterRotateCell2 pivot (rotateCell pivot cell)) checkForNothing::[Maybe(Cell, Fallimento)] -> Maybe(Cell, Fallimento) checkForNothing (Nothing:xs) = checkForNothing xs checkForNothing ((Just v):xs) = Just v checkForNothing [] = Nothing testTutteRotazioni = checkForNothing [ testDoppieRotazioni (2,3) [(2,0), (4,1), (5,4), (3,6), (0,5), (0,2), (2,0)], testDoppieRotazioni (2,4) [(2,1), (4,3), (4,6), (1,7), (-1,5), (0,2), (2,1)], testDoppieRotazioni (1,5) [(1,3), (3,4), (3,6), (1,7), (0,6), (0,4), (1,3)] ] testCentering = deepCheck (\up um um1 -> let b = Board 5 10 (Set.fromList []) u = Unit (Set.fromList (um1:um)) up c = centerUnit u b bw = 5 xCoords = Set.map (\(x, y) -> x) (unitMembers c) yCoords = Set.map (\(x, y) -> y) (unitMembers c) unitLeft = Set.findMin xCoords unitRight = Set.findMax xCoords unitTop = Set.findMin yCoords deltaLeft = unitLeft deltaRight = bw - unitRight - 1 in (deltaLeft == deltaRight || (deltaRight - deltaLeft) == 1) && unitTop == 0) testGame = let board = Board 5 10 (Set.fromList []) unit = Unit (Set.fromList [(2, 8)]) (2, 8) game = Game board [unit] (Set.fromList [hash unit]) in game data Fallimento = Rotazione | ControRotazione deriving Show testDoppieRotazioni :: Cell -> [Cell] -> Maybe (Cell, Fallimento) testDoppieRotazioni pivot cells = case testRotazioni pivot cells of Just v -> Just (v, Rotazione) Nothing -> case testControRotazioni pivot (reverse cells) of Just w -> Just (w, ControRotazione) Nothing -> Nothing -- restituisce eventualmente il primo valore per cui fallisce testRotazioni :: Cell -> [Cell] -> Maybe Cell testRotazioni _ [] = Nothing testRotazioni _ [x] = Nothing testRotazioni pivot (x:y:xs) = if rotateCell pivot x == y then testRotazioni pivot (y:xs) else Just x -- restituisce eventualmente il primo valore per cui fallisce testControRotazioni :: Cell -> [Cell] -> Maybe Cell testControRotazioni _ [] = Nothing testControRotazioni _ [x] = Nothing testControRotazioni pivot (x:y:xs) = if counterRotateCell pivot x == y then testControRotazioni pivot (y:xs) else Just x