Add createBoard function

src/Lib.hs

@@ -1,5 +1,6 @@
 module Lib
-  ( flagTile
+  ( createBoard
+  , flagTile
   , revealTile
   , printBoard
   , Board(..)
@@ -26,6 +27,18 @@ data TileState
 
 type Coordinates = (Int, Int)
 
+createBoard :: Int -> Int -> [Coordinates] -> Board
+createBoard boardWidth boardLength bombs = Board $ foldr placeBomb createClearBoard bombs
+  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
+
 flagTile :: Coordinates -> Board -> Board
 flagTile (x, y) (Board board) =
   case findTile (Board board) (x, y) of
@@ -43,12 +56,7 @@ revealTile (x, y) (Board board) =
     Nothing     -> Board board
   where
     revealHiddenTile (Value 0 Hidden) =
-      revealTile (x - 1, y - 1) .
+      mapAroundTile revealTile (x, y) $ replaceTile (Board board) (x, y) (Value 0 Revealed)
-      revealTile (x, y - 1) .
-      revealTile (x + 1, y - 1) .
-      revealTile (x - 1, y) .
-      revealTile (x + 1, y) . revealTile (x - 1, y + 1) . revealTile (x, y + 1) . revealTile (x + 1, y + 1) $
-      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
@@ -90,3 +98,8 @@ printBoard (Board board) = concatMap printLine board
     printTile (Value x Revealed) = show x
     printTile (Bomb Flagged)     = "F"
     printTile (Value _ Flagged)  = "F"
+
+mapAroundTile :: (Coordinates -> Board -> Board) -> Coordinates -> Board -> Board
+mapAroundTile f (x, y) =
+  f (x - 1, y - 1) .
+  f (x, y - 1) . f (x + 1, y - 1) . f (x - 1, y) . f (x + 1, y) . f (x - 1, y + 1) . f (x, y + 1) . f (x + 1, y + 1)

test/Spec.hs

@@ -3,10 +3,10 @@ import           Test.Tasty
 import           Test.Tasty.HUnit
 
 main :: IO ()
-main = defaultMain $ testGroup "Minesweeper tests" [flagTileTest, revealTileTest]
+main = defaultMain $ testGroup "Minesweeper tests" [flagTileTest, revealTileTest, createBoardTest]
 
 emptyBoard :: Board
-emptyBoard = Board [[]]
+emptyBoard = Board []
 
 hiddenBoard :: Board
 hiddenBoard =
@@ -70,3 +70,25 @@ revealTileTest =
     , testCase "Flag revealed bomb tile" $ revealTile (0, 0) revealedBoard @?= revealedBoard
     , testCase "Flag revealed value tile" $ revealTile (1, 2) revealedBoard @?= revealedBoard
     ]
+
+createBoardTest :: TestTree
+createBoardTest =
+  testGroup
+    "Create board"
+    [ testCase "Empty board" $ createBoard 0 0 [] @?= emptyBoard
+    , 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]
+        ]
+    , 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]
+        ]
+    ]