diff --git a/app/Main.hs b/app/Main.hs index c1f77e9..a34a838 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -3,8 +3,10 @@ module Main where import Lib main :: IO () -main = putStrLn $ printBoard (Board - [ [Bomb 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] - ]) +main = + putStrLn $ + printBoard + [ [Bomb 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] + ] diff --git a/src/Lib.hs b/src/Lib.hs index 2912225..baf23fd 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -3,16 +3,12 @@ module Lib , flagTile , revealTile , printBoard - , Board(..) + , Board , Tile(..) , TileState(..) ) where -newtype Board = - Board - { unBoard :: [[Tile]] - } - deriving (Eq, Show) +type Board = [[Tile]] data Tile = Value Int TileState @@ -28,41 +24,39 @@ data TileState type Coordinates = (Int, Int) createBoard :: Int -> Int -> [Coordinates] -> Board -createBoard boardWidth boardLength bombs = Board $ foldr placeBomb createClearBoard bombs +createBoard boardWidth boardLength = foldr placeBomb createClearBoard where createClearBoard = replicate boardLength createClearLine createClearLine = replicate boardWidth (Value 0 Hidden) - placeBomb (x, y) board = - unBoard $ mapAroundTile incrementValueTile (x, y) $ replaceTile (Board board) (x, y) (Bomb Hidden) - incrementValueTile (x, y) (Board board) = - case findTile (Board board) (x, y) of - (Just (Value value Hidden)) -> replaceTile (Board board) (x, y) (Value (value + 1) Hidden) - _ -> Board board + placeBomb (x, y) board = mapAroundTile incrementValueTile (x, y) $ replaceTile board (x, y) (Bomb Hidden) + incrementValueTile (x, y) board = + case findTile board (x, y) of + (Just (Value value Hidden)) -> replaceTile board (x, y) (Value (value + 1) Hidden) + _ -> board flagTile :: Coordinates -> Board -> Board -flagTile (x, y) (Board board) = - case findTile (Board board) (x, y) of +flagTile (x, y) board = + case findTile board (x, y) of (Just tile) -> flagHiddenTile tile - Nothing -> Board board + Nothing -> board where - flagHiddenTile (Value value Hidden) = replaceTile (Board board) (x, y) (Value value Flagged) - flagHiddenTile (Bomb Hidden) = replaceTile (Board board) (x, y) (Bomb Flagged) - flagHiddenTile _ = Board board + flagHiddenTile (Value value Hidden) = replaceTile board (x, y) (Value value Flagged) + flagHiddenTile (Bomb Hidden) = replaceTile board (x, y) (Bomb Flagged) + flagHiddenTile _ = board revealTile :: Coordinates -> Board -> Board -revealTile (x, y) (Board board) = - case findTile (Board board) (x, y) of +revealTile (x, y) board = + case findTile board (x, y) of (Just tile) -> revealHiddenTile tile - Nothing -> Board board + Nothing -> board where - revealHiddenTile (Value 0 Hidden) = - mapAroundTile revealTile (x, y) $ replaceTile (Board board) (x, y) (Value 0 Revealed) - revealHiddenTile (Value value Hidden) = replaceTile (Board board) (x, y) (Value value Revealed) - revealHiddenTile (Bomb Hidden) = revealAll (Board board) - revealHiddenTile _ = Board board + revealHiddenTile (Value 0 Hidden) = mapAroundTile revealTile (x, y) $ replaceTile board (x, y) (Value 0 Revealed) + revealHiddenTile (Value value Hidden) = replaceTile board (x, y) (Value value Revealed) + revealHiddenTile (Bomb Hidden) = revealAll board + revealHiddenTile _ = board revealAll :: Board -> Board -revealAll (Board board) = Board $ map revealLine board +revealAll = map revealLine where revealLine = map revealSingleTile revealSingleTile (Value value Hidden) = Value value Revealed @@ -70,26 +64,26 @@ revealAll (Board board) = Board $ map revealLine board revealSingleTile tile = tile replaceTile :: Board -> Coordinates -> Tile -> Board -replaceTile (Board board) (x, y) tile = +replaceTile board (x, y) tile = let (firstRows, line:lastRows) = splitAt y board (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 board) (x, y) = - if not (coordinatesExists (Board board) (x, y)) +findTile board (x, y) = + if not (coordinatesExists board (x, y)) then Nothing else Just $ board !! y !! x coordinatesExists :: Board -> Coordinates -> Bool -coordinatesExists (Board board) (x, y) = isPositive && isYWithinTheBoard board && isXWithinTheBoard board +coordinatesExists board (x, y) = isPositive && isYWithinTheBoard board && isXWithinTheBoard board where isPositive = x >= 0 && y >= 0 isYWithinTheBoard = (> y) . length isXWithinTheBoard = any ((> x) . length) printBoard :: Board -> String -printBoard (Board board) = concatMap printLine board +printBoard = concatMap printLine where printLine line = concatMap printTile line ++ "\n" printTile (Bomb Hidden) = "#" diff --git a/test/Spec.hs b/test/Spec.hs index f4e0192..21f191a 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -5,44 +5,37 @@ import Test.Tasty.HUnit main :: IO () main = defaultMain $ testGroup "Minesweeper tests" [flagTileTest, revealTileTest, createBoardTest] -emptyBoard :: Board -emptyBoard = Board [] - hiddenBoard :: Board hiddenBoard = - Board - [ [Bomb 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] - ] + [ [Bomb 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] + ] revealedBoard :: Board revealedBoard = - Board - [ [Bomb 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] - ] + [ [Bomb 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] + ] flagTileTest :: TestTree flagTileTest = testGroup "Flag tile" - [ testCase "Empty board" $ flagTile (1, 1) emptyBoard @?= emptyBoard + [ testCase "Empty board" $ flagTile (1, 1) [] @?= [] , testCase "Flag bomb tile" $ flagTile (0, 0) hiddenBoard @?= - Board - [ [Bomb Flagged, Value 1 Hidden, Value 0 Hidden] - , [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden] - , [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden] - ] + [ [Bomb Flagged, Value 1 Hidden, Value 0 Hidden] + , [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden] + , [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden] + ] , testCase "Flag value tile" $ flagTile (2, 0) hiddenBoard @?= - Board - [ [Bomb Hidden, Value 1 Hidden, Value 0 Flagged] - , [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden] - , [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden] - ] + [ [Bomb Hidden, Value 1 Hidden, Value 0 Flagged] + , [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden] + , [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden] + ] , testCase "Flag revealed bomb tile" $ flagTile (0, 0) revealedBoard @?= revealedBoard , testCase "Flag revealed value tile" $ flagTile (1, 2) revealedBoard @?= revealedBoard ] @@ -51,22 +44,20 @@ revealTileTest :: TestTree revealTileTest = testGroup "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 "Flag 0 value tile" $ revealTile (2, 0) hiddenBoard @?= - Board - [ [Bomb Hidden, Value 1 Revealed, Value 0 Revealed] - , [Value 1 Revealed, Value 1 Revealed, Value 0 Revealed] - , [Value 0 Revealed, Value 0 Revealed, Value 0 Revealed] - ] + [ [Bomb Hidden, Value 1 Revealed, Value 0 Revealed] + , [Value 1 Revealed, Value 1 Revealed, Value 0 Revealed] + , [Value 0 Revealed, Value 0 Revealed, Value 0 Revealed] + ] , testCase "Flag non 0 value tile" $ revealTile (1, 0) hiddenBoard @?= - Board - [ [Bomb Hidden, Value 1 Revealed, Value 0 Hidden] - , [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden] - , [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden] - ] + [ [Bomb Hidden, Value 1 Revealed, Value 0 Hidden] + , [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden] + , [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden] + ] , testCase "Flag revealed bomb tile" $ revealTile (0, 0) revealedBoard @?= revealedBoard , testCase "Flag revealed value tile" $ revealTile (1, 2) revealedBoard @?= revealedBoard ] @@ -75,20 +66,18 @@ createBoardTest :: TestTree createBoardTest = testGroup "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 three bombs" $ createBoard 3 3 [(0, 0), (1, 1), (2, 2)] @?= - Board - [ [Bomb Hidden, Value 2 Hidden, Value 1 Hidden] - , [Value 2 Hidden, Bomb Hidden, Value 2 Hidden] - , [Value 1 Hidden, Value 2 Hidden, Bomb Hidden] - ] + [ [Bomb Hidden, Value 2 Hidden, Value 1 Hidden] + , [Value 2 Hidden, Bomb Hidden, Value 2 Hidden] + , [Value 1 Hidden, Value 2 Hidden, Bomb Hidden] + ] , testCase "3x3 four bombs" $ createBoard 3 3 [(0, 1), (1, 1), (2, 1), (1, 0)] @?= - Board - [ [Value 3 Hidden, Bomb Hidden, Value 3 Hidden] - , [Bomb Hidden, Bomb Hidden, Bomb Hidden] - , [Value 2 Hidden, Value 3 Hidden, Value 2 Hidden] - ] + [ [Value 3 Hidden, Bomb Hidden, Value 3 Hidden] + , [Bomb Hidden, Bomb Hidden, Bomb Hidden] + , [Value 2 Hidden, Value 3 Hidden, Value 2 Hidden] + ] ]