Minesweeper

Main.hs

module Main where

-- from "monoidal-containers" package
import qualified Data.IntMap.Monoidal.Strict as M
-- The thing with this IntMap is that whenever
-- its elements form a semigroup, the IntMaps
-- containing those elements themselves form
-- a monoid that works "pointwise"

-- Just type synonyms
type Height = Int
type Width = Int

data Cell = Bomb | Number Int
  deriving Eq

data Board = Board
  { height :: Height
  , width  :: Width
  , cells  :: M.MonoidalIntMap Cell
  }

instance Show Cell where
  show Bomb       = "b"
  show (Number a) = show a

instance Show Board where
  show board@Board{height = h, width = w} =
    concatMap showRow [0..h-1]
    where
      showRow y = show row <> "\n"
        where row = map (\x -> cellAt board x y) [0..w-1]

-- Hopefully you've heard of semigroups?
instance Semigroup Cell where
  Bomb <> _ = Bomb
  _ <> Bomb = Bomb
  Number a <> Number b = Number $ a + b

instance Semigroup Board where
  boardA <> boardB = if hA /= hB || wA /= wB
    then error "Cannot concatenate boards with different dimensions"
    else Board hA wA $ cA <> cB
    where
      hA = height boardA
      hB = height boardB
      wA = width boardA
      wB = width boardB
      cA = cells boardA
      cB = cells boardB
-- Now we can take two boards and (<>) them together
-- try: sampleBoard <> sampleBoard

-- An example board with two bombs
sampleBoard :: Board
sampleBoard = Board 3 3 $
  M.fromList $ [0..8] `zip`
  [ Number 0, Number 0, Number 0
  , Number 0, Bomb    , Number 0
  , Number 0, Number 0, Bomb
  ]

-- A board filled with zeroes
nullBoard :: Height -> Width -> Board
nullBoard h w = Board h w $
  M.fromList $ [0..h*w-1] `zip`
  repeat (Number 0)

-- Coords origin on a board is its left upper corner
--   0---------> x
--   |
--   |
--   |
--   |
--   v
--   y

-- Transform coords into IntMap index
flattenCoords :: Board -> Int -> Int -> Int
flattenCoords Board{width = w} x y =
  x + (y * w)

-- Transform IntMap index into coords
unFlattenCoords :: Board -> Int -> (Int, Int)
unFlattenCoords Board{height = h} i =
  (i `mod` h, i `div` h)

-- Pick a cell in a given board at given coords
cellAt :: Board -> Int -> Int -> Cell
cellAt board x y =
  cells board M.! (flattenCoords board x y)

-- At given coords in a given board, apply a function
-- that transforms a cell at that coords
modifyCellAt :: Board -> Int -> Int -> (Cell -> Cell) -> Board
modifyCellAt board x y f =
  board { cells = M.adjust f i (cells board) }
  where i = flattenCoords board x y


-- Get adjacent squares around given coords
adjacent :: Int -> Int -> [(Int, Int)]
adjacent x y = [(x + a, y + b) | a <- [-1..1], b <- [-1..1]]

-- Create a board with given height and width that
-- consists of zeroes everywhere except around given
-- coords, where it's filled with a given cell
-- Example:
-- surroundedBy 3 3 Bomb 0 0
-- [b,b,0]
-- [b,b,0]
-- [0,0,0]
surroundedBy :: Height -> Width -> Cell -> Int -> Int -> Board
surroundedBy h w c x y = foldl go (nullBoard h w) adj
  where
    adj = filter
      (\(x,y) -> x >= 0 && y >= 0 && x < w && y < h) $
      adjacent x y

    go :: Board -> (Int, Int) -> Board
    go board (x,y) = modifyCellAt board x y (const c)


-- Return all bombs' coords in a board
getBombs :: Board -> [(Int,Int)]
getBombs board =
  map (unFlattenCoords board) .
  map fst .
  filter (\(i,c) -> c == Bomb) $ cellsList
  where
    cellsList = M.toList $ cells board

-- Speaks for itself
markBombs :: Board -> Board
markBombs unMarkedBoard =
  foldl (<>) unMarkedBoard .
  map surround .
  getBombs $ unMarkedBoard
  where
    surround = uncurry $
      surroundedBy h w (Number 1)
    h = height unMarkedBoard
    w = width unMarkedBoard

main = do
  putStrLn "Unmarked board:"
  print sampleBoard
  putStrLn "Marked board:"
  print $ markBombs sampleBoard