Code cleanup and renamings

src/Main.hs

@@ -22,10 +22,7 @@ setup w = void $ do
     UI.addStyleSheet w "minesweeper.css"
 
     rng <- liftIO newStdGen
-    --let board = createBoard 10 0.2 rng
+    let board = uncover (createBoard 30 0.15 rng) (4,4)
-    let board = uncover (createBoard 30 0.1 rng) (4,4)
-    --let board = uncoverSafeAdjacents board (4,4)
-    --let board = uncoverSafe board [(3,4)]
 
     getBody w #+ [
         UI.div #. "container" #+ [
@@ -38,11 +35,12 @@ gameGridTable :: Board -> UI Element
 gameGridTable b = mkElement "table" #+ rows b
 
 rows :: Board -> [UI Element]
-rows b = rows2 b 0
+rows b = rows' b 0
-rows2 b r | r < size b = (mkElement "tr" #+ cells b r) : rows2 b (r+1)
+rows' b r | r < size b = (mkElement "tr" #+ cells b r) : rows' b (r+1)
           | otherwise = []
 
 cells :: Board -> Int -> [UI Element]
-cells b r = cells2 b r 0
+cells b r = cells' b r 0
-cells2 b r c | c < size b = mkElement "td" #. (squareColour b (r,c) ++ " " ++ squareTextColour b (r,c)) #+ [string $ squareAscii b (r,c)] : cells2 b r (c+1)
+cells' b r c | c < size b = mkElement "td" #. (squareBgColour b (r,c) ++ " " ++ squareTextColour b (r,c)) 
+                                           #+ [string $ squareAscii b (r,c)] : cells' b r (c+1)
              | otherwise = []

src/Minesweeper.hs

@@ -9,7 +9,7 @@ data Board = Board { size :: Int
                    , mines :: Grid
                    , uncovered :: Grid
                    , flagged :: Grid
-                   } deriving (Show)
+                   }
 
 -- Creates a board given a size (width/height), mine ratio and random generator
 createBoard :: Int -> Float -> StdGen -> Board
@@ -28,16 +28,16 @@ seedGrid rng p (l:ls) = newL : seedGrid rng2 p ls
                               (newL, _) = seedList rng1 p l
 
 seedList :: StdGen -> Float -> [Bool] -> ([Bool], StdGen)
-seedList rng p (l:ls) = (newBool : seedList2 newRng p ls, newRng)
+seedList rng p (l:ls) = (newBool : seedList' newRng p ls, newRng)
-                        where (newBool, newRng) = randomlyTrue rng p
+                        where (newBool, newRng) = weightedRandomBool rng p
+seedList' :: StdGen -> Float -> [Bool] -> [Bool]
+seedList' _ _ [] = []
+seedList' rng p (l:ls) = newBool : seedList' newRng p ls
+                         where (newBool, newRng) = weightedRandomBool rng p
 
-seedList2 :: StdGen -> Float -> [Bool] -> [Bool]
+-- Returns true with probability p, otherwise false
-seedList2 _ _ [] = []
+weightedRandomBool :: StdGen -> Float -> (Bool, StdGen)
-seedList2 rng p (l:ls) = newBool : seedList2 newRng p ls
+weightedRandomBool rng p = (generatedFloat <= p, newRng)
-                         where (newBool, newRng) = randomlyTrue rng p
-
-randomlyTrue :: StdGen -> Float -> (Bool, StdGen)
-randomlyTrue rng p = (generatedFloat <= p, newRng)
                      where (generatedFloat, newRng) = randomR (0.0, 1.0) rng
 
 -- Functions for determing statuses and info on square(s)
@@ -62,17 +62,17 @@ onEdge b (r,c) = r == 0 || c == 0 || r+1 == size b || c+1 == size b
 
 squareAscii :: Board -> Square -> String
 squareAscii b (r,c) | isUncovered b (r,c) && hasMine b (r,c) = "X"
-                    | isUncovered b (r,c) && adjacentToCovered b (r,c) = show $ adjacentBombs b (r,c)
+                    | isUncovered b (r,c) && adjacentToCovered b (r,c) = show $ adjacentMines b (r,c)
                     | otherwise = ""
 
-squareColour :: Board -> Square -> String
+squareBgColour :: Board -> Square -> String
-squareColour b (r,c) | isUncovered b (r,c) && hasMine b (r,c) = "bomb"
+squareBgColour b (r,c) | isUncovered b (r,c) && hasMine b (r,c) = "bomb"
-                     | isUncovered b (r,c) = "uncovered"
+                       | isUncovered b (r,c) = "uncovered"
-                     | otherwise = "covered"
+                       | otherwise = "covered"
 
 squareTextColour :: Board -> Square -> String
 squareTextColour b (r,c) | isUncovered b (r,c) && adjacentToCovered b (r,c) = 
-                           case adjacentBombs b (r,c) of
+                           case adjacentMines b (r,c) of
                               1 -> "text-blue"
                               2 -> "text-green"
                               3 -> "text-red"
@@ -83,8 +83,8 @@ squareTextColour b (r,c) | isUncovered b (r,c) && adjacentToCovered b (r,c) =
                               8 -> "text-gray"
                          | otherwise = ""
 
-adjacentBombs :: Board -> Square -> Int
+adjacentMines :: Board -> Square -> Int
-adjacentBombs b (r,c) = sum $ map (boolToInt . hasMine b) $ adjacentSquares (r,c)
+adjacentMines b (r,c) = sum $ map (boolToInt . hasMine b) $ adjacentSquares (r,c)
 
 adjacentToCovered :: Board -> Square -> Bool
 adjacentToCovered b (r,c) = not $ all (isUncovered b) $ adjacentSquares (r,c)
@@ -98,6 +98,8 @@ boolToInt x | x = 1
 
 -- Functions for changing the status of square(s)
 
+-- uncovers a square and recursively uncovers adjacent squares iff the square has zero adjacent mines
+-- N.B. not very efficient due to lots of splitting and remerging
 uncover :: Board -> Square -> Board
 uncover b (r,c) | not $ validSquare b (r,c) = b
                 | isUncovered b (r,c) = b
@@ -109,9 +111,10 @@ uncover b (r,c) | not $ validSquare b (r,c) = b
                               in uncoverAdjacentsIfSafe (Board s m newRows f) (r,c)
 
 uncoverAdjacentsIfSafe :: Board -> Square -> Board
-uncoverAdjacentsIfSafe b (r,c) | adjacentBombs b (r,c) == 0 = uncoverAll b $ adjacentSquares (r,c)
+uncoverAdjacentsIfSafe b (r,c) | adjacentMines b (r,c) == 0 = uncoverAll b $ adjacentSquares (r,c)
                                | otherwise = b
 
+-- uncovers all squares given in a list
 uncoverAll :: Board -> [Square] -> Board
 uncoverAll b [] = b
 uncoverAll b ((r,c):xs) = uncoverAll newB xs where newB = uncover b (r,c)