Make Board a type synonym isntead of a newtype

This commit is contained in:
Paul-Henri Froidmont 2019-11-24 17:06:51 +01:00 committed by Paul-Henri Froidmont
parent 4030ae7699
commit 0b20ec98e3
3 changed files with 70 additions and 85 deletions

View file

@ -3,8 +3,10 @@ module Main where
import Lib import Lib
main :: IO () main :: IO ()
main = putStrLn $ printBoard (Board main =
putStrLn $
printBoard
[ [Bomb Revealed, Value 1 Revealed, Value 0 Revealed] [ [Bomb Revealed, Value 1 Revealed, Value 0 Revealed]
, [Value 1 Revealed, Value 1 Revealed, Value 0 Revealed] , [Value 1 Revealed, Value 1 Revealed, Value 0 Revealed]
, [Value 0 Revealed, Value 0 Revealed, Value 0 Revealed] , [Value 0 Revealed, Value 0 Revealed, Value 0 Revealed]
]) ]

View file

@ -3,16 +3,12 @@ module Lib
, flagTile , flagTile
, revealTile , revealTile
, printBoard , printBoard
, Board(..) , Board
, Tile(..) , Tile(..)
, TileState(..) , TileState(..)
) where ) where
newtype Board = type Board = [[Tile]]
Board
{ unBoard :: [[Tile]]
}
deriving (Eq, Show)
data Tile data Tile
= Value Int TileState = Value Int TileState
@ -28,41 +24,39 @@ data TileState
type Coordinates = (Int, Int) type Coordinates = (Int, Int)
createBoard :: Int -> Int -> [Coordinates] -> Board createBoard :: Int -> Int -> [Coordinates] -> Board
createBoard boardWidth boardLength bombs = Board $ foldr placeBomb createClearBoard bombs createBoard boardWidth boardLength = foldr placeBomb createClearBoard
where where
createClearBoard = replicate boardLength createClearLine createClearBoard = replicate boardLength createClearLine
createClearLine = replicate boardWidth (Value 0 Hidden) createClearLine = replicate boardWidth (Value 0 Hidden)
placeBomb (x, y) board = placeBomb (x, y) board = mapAroundTile incrementValueTile (x, y) $ replaceTile board (x, y) (Bomb Hidden)
unBoard $ mapAroundTile incrementValueTile (x, y) $ replaceTile (Board board) (x, y) (Bomb Hidden) incrementValueTile (x, y) board =
incrementValueTile (x, y) (Board board) = case findTile board (x, y) of
case findTile (Board board) (x, y) of (Just (Value value Hidden)) -> replaceTile board (x, y) (Value (value + 1) Hidden)
(Just (Value value Hidden)) -> replaceTile (Board board) (x, y) (Value (value + 1) Hidden) _ -> board
_ -> Board board
flagTile :: Coordinates -> Board -> Board flagTile :: Coordinates -> Board -> Board
flagTile (x, y) (Board board) = flagTile (x, y) board =
case findTile (Board board) (x, y) of case findTile board (x, y) of
(Just tile) -> flagHiddenTile tile (Just tile) -> flagHiddenTile tile
Nothing -> Board board Nothing -> board
where where
flagHiddenTile (Value value Hidden) = replaceTile (Board board) (x, y) (Value value Flagged) flagHiddenTile (Value value Hidden) = replaceTile board (x, y) (Value value Flagged)
flagHiddenTile (Bomb Hidden) = replaceTile (Board board) (x, y) (Bomb Flagged) flagHiddenTile (Bomb Hidden) = replaceTile board (x, y) (Bomb Flagged)
flagHiddenTile _ = Board board flagHiddenTile _ = board
revealTile :: Coordinates -> Board -> Board revealTile :: Coordinates -> Board -> Board
revealTile (x, y) (Board board) = revealTile (x, y) board =
case findTile (Board board) (x, y) of case findTile board (x, y) of
(Just tile) -> revealHiddenTile tile (Just tile) -> revealHiddenTile tile
Nothing -> Board board Nothing -> board
where where
revealHiddenTile (Value 0 Hidden) = revealHiddenTile (Value 0 Hidden) = mapAroundTile revealTile (x, y) $ replaceTile board (x, y) (Value 0 Revealed)
mapAroundTile revealTile (x, y) $ replaceTile (Board board) (x, y) (Value 0 Revealed) revealHiddenTile (Value value Hidden) = replaceTile board (x, y) (Value value Revealed)
revealHiddenTile (Value value Hidden) = replaceTile (Board board) (x, y) (Value value Revealed) revealHiddenTile (Bomb Hidden) = revealAll board
revealHiddenTile (Bomb Hidden) = revealAll (Board board) revealHiddenTile _ = board
revealHiddenTile _ = Board board
revealAll :: Board -> Board revealAll :: Board -> Board
revealAll (Board board) = Board $ map revealLine board revealAll = map revealLine
where where
revealLine = map revealSingleTile revealLine = map revealSingleTile
revealSingleTile (Value value Hidden) = Value value Revealed revealSingleTile (Value value Hidden) = Value value Revealed
@ -70,26 +64,26 @@ revealAll (Board board) = Board $ map revealLine board
revealSingleTile tile = tile revealSingleTile tile = tile
replaceTile :: Board -> Coordinates -> Tile -> Board replaceTile :: Board -> Coordinates -> Tile -> Board
replaceTile (Board board) (x, y) tile = replaceTile board (x, y) tile =
let (firstRows, line:lastRows) = splitAt y board let (firstRows, line:lastRows) = splitAt y board
(firstTiles, _:lastTiles) = splitAt x line (firstTiles, _:lastTiles) = splitAt x line
in Board $ firstRows ++ (firstTiles ++ tile : lastTiles) : lastRows in firstRows ++ (firstTiles ++ tile : lastTiles) : lastRows
findTile :: Board -> Coordinates -> Maybe Tile findTile :: Board -> Coordinates -> Maybe Tile
findTile (Board board) (x, y) = findTile board (x, y) =
if not (coordinatesExists (Board board) (x, y)) if not (coordinatesExists board (x, y))
then Nothing then Nothing
else Just $ board !! y !! x else Just $ board !! y !! x
coordinatesExists :: Board -> Coordinates -> Bool coordinatesExists :: Board -> Coordinates -> Bool
coordinatesExists (Board board) (x, y) = isPositive && isYWithinTheBoard board && isXWithinTheBoard board coordinatesExists board (x, y) = isPositive && isYWithinTheBoard board && isXWithinTheBoard board
where where
isPositive = x >= 0 && y >= 0 isPositive = x >= 0 && y >= 0
isYWithinTheBoard = (> y) . length isYWithinTheBoard = (> y) . length
isXWithinTheBoard = any ((> x) . length) isXWithinTheBoard = any ((> x) . length)
printBoard :: Board -> String printBoard :: Board -> String
printBoard (Board board) = concatMap printLine board printBoard = concatMap printLine
where where
printLine line = concatMap printTile line ++ "\n" printLine line = concatMap printTile line ++ "\n"
printTile (Bomb Hidden) = "#" printTile (Bomb Hidden) = "#"

View file

@ -5,12 +5,8 @@ import Test.Tasty.HUnit
main :: IO () main :: IO ()
main = defaultMain $ testGroup "Minesweeper tests" [flagTileTest, revealTileTest, createBoardTest] main = defaultMain $ testGroup "Minesweeper tests" [flagTileTest, revealTileTest, createBoardTest]
emptyBoard :: Board
emptyBoard = Board []
hiddenBoard :: Board hiddenBoard :: Board
hiddenBoard = hiddenBoard =
Board
[ [Bomb Hidden, Value 1 Hidden, Value 0 Hidden] [ [Bomb Hidden, Value 1 Hidden, Value 0 Hidden]
, [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden] , [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden]
, [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden] , [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden]
@ -18,7 +14,6 @@ hiddenBoard =
revealedBoard :: Board revealedBoard :: Board
revealedBoard = revealedBoard =
Board
[ [Bomb Revealed, Value 1 Revealed, Value 0 Revealed] [ [Bomb Revealed, Value 1 Revealed, Value 0 Revealed]
, [Value 1 Revealed, Value 1 Revealed, Value 0 Revealed] , [Value 1 Revealed, Value 1 Revealed, Value 0 Revealed]
, [Value 0 Revealed, Value 0 Revealed, Value 0 Revealed] , [Value 0 Revealed, Value 0 Revealed, Value 0 Revealed]
@ -28,17 +23,15 @@ flagTileTest :: TestTree
flagTileTest = flagTileTest =
testGroup testGroup
"Flag tile" "Flag tile"
[ testCase "Empty board" $ flagTile (1, 1) emptyBoard @?= emptyBoard [ testCase "Empty board" $ flagTile (1, 1) [] @?= []
, testCase "Flag bomb tile" $ , testCase "Flag bomb tile" $
flagTile (0, 0) hiddenBoard @?= flagTile (0, 0) hiddenBoard @?=
Board
[ [Bomb Flagged, Value 1 Hidden, Value 0 Hidden] [ [Bomb Flagged, Value 1 Hidden, Value 0 Hidden]
, [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden] , [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden]
, [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden] , [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden]
] ]
, testCase "Flag value tile" $ , testCase "Flag value tile" $
flagTile (2, 0) hiddenBoard @?= flagTile (2, 0) hiddenBoard @?=
Board
[ [Bomb Hidden, Value 1 Hidden, Value 0 Flagged] [ [Bomb Hidden, Value 1 Hidden, Value 0 Flagged]
, [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden] , [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden]
, [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden] , [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden]
@ -51,18 +44,16 @@ revealTileTest :: TestTree
revealTileTest = revealTileTest =
testGroup testGroup
"Reveal tile" "Reveal tile"
[ testCase "Empty board" $ revealTile (1, 1) emptyBoard @?= emptyBoard [ testCase "Empty board" $ revealTile (1, 1) [] @?= []
, testCase "Reveal bomb tile" $ revealTile (0, 0) hiddenBoard @?= revealedBoard , testCase "Reveal bomb tile" $ revealTile (0, 0) hiddenBoard @?= revealedBoard
, testCase "Flag 0 value tile" $ , testCase "Flag 0 value tile" $
revealTile (2, 0) hiddenBoard @?= revealTile (2, 0) hiddenBoard @?=
Board
[ [Bomb Hidden, Value 1 Revealed, Value 0 Revealed] [ [Bomb Hidden, Value 1 Revealed, Value 0 Revealed]
, [Value 1 Revealed, Value 1 Revealed, Value 0 Revealed] , [Value 1 Revealed, Value 1 Revealed, Value 0 Revealed]
, [Value 0 Revealed, Value 0 Revealed, Value 0 Revealed] , [Value 0 Revealed, Value 0 Revealed, Value 0 Revealed]
] ]
, testCase "Flag non 0 value tile" $ , testCase "Flag non 0 value tile" $
revealTile (1, 0) hiddenBoard @?= revealTile (1, 0) hiddenBoard @?=
Board
[ [Bomb Hidden, Value 1 Revealed, Value 0 Hidden] [ [Bomb Hidden, Value 1 Revealed, Value 0 Hidden]
, [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden] , [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden]
, [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden] , [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden]
@ -75,18 +66,16 @@ createBoardTest :: TestTree
createBoardTest = createBoardTest =
testGroup testGroup
"Create board" "Create board"
[ testCase "Empty board" $ createBoard 0 0 [] @?= emptyBoard [ testCase "Empty board" $ createBoard 0 0 [] @?= []
, testCase "3x3 single bomb" $ createBoard 3 3 [(0, 0)] @?= hiddenBoard , testCase "3x3 single bomb" $ createBoard 3 3 [(0, 0)] @?= hiddenBoard
, testCase "3x3 three bombs" $ , testCase "3x3 three bombs" $
createBoard 3 3 [(0, 0), (1, 1), (2, 2)] @?= createBoard 3 3 [(0, 0), (1, 1), (2, 2)] @?=
Board
[ [Bomb Hidden, Value 2 Hidden, Value 1 Hidden] [ [Bomb Hidden, Value 2 Hidden, Value 1 Hidden]
, [Value 2 Hidden, Bomb Hidden, Value 2 Hidden] , [Value 2 Hidden, Bomb Hidden, Value 2 Hidden]
, [Value 1 Hidden, Value 2 Hidden, Bomb Hidden] , [Value 1 Hidden, Value 2 Hidden, Bomb Hidden]
] ]
, testCase "3x3 four bombs" $ , testCase "3x3 four bombs" $
createBoard 3 3 [(0, 1), (1, 1), (2, 1), (1, 0)] @?= createBoard 3 3 [(0, 1), (1, 1), (2, 1), (1, 0)] @?=
Board
[ [Value 3 Hidden, Bomb Hidden, Value 3 Hidden] [ [Value 3 Hidden, Bomb Hidden, Value 3 Hidden]
, [Bomb Hidden, Bomb Hidden, Bomb Hidden] , [Bomb Hidden, Bomb Hidden, Bomb Hidden]
, [Value 2 Hidden, Value 3 Hidden, Value 2 Hidden] , [Value 2 Hidden, Value 3 Hidden, Value 2 Hidden]