Minesweeper.hs

module Minesweeper where
import Data.List (delete, maximumBy)
import Data.Char (intToDigit, digitToInt)
import Data.Ord (comparing)
import Test.QuickCheck

-- Tests!
newtype InputFormat = InputFormat [String] deriving (Show)

instance Arbitrary InputFormat where
  arbitrary = do
    width <- choose (1,20)
    height <- choose (1,20)
    rows <- vectorOf width (vectorOf height $ elements "*-")
    return $ InputFormat rows
  shrink (InputFormat xs) = map InputFormat $ shrink xs

prop_shape_stays_constant :: InputFormat -> Bool
prop_shape_stays_constant (InputFormat xs) = length inp == length res
  where
    inp = concat xs
    res = concat $ generateMineField xs

prop_mines_stay_put :: InputFormat -> Bool
prop_mines_stay_put (InputFormat xs) = and $ zipWith zipper inp res
  where
    inp = concat xs
    res = concat $ generateMineField xs
    zipper '*' '*' = True
    zipper _   '*' = False
    zipper '*' _   = False
    zipper _   _   = True

prop_numbers_between_0_8 :: InputFormat -> Bool
prop_numbers_between_0_8 (InputFormat xs) =
  not $ null res && -- must make sure the list isn't empty
  all ((>) 8 . digitToInt) res
  where
    res = filter (/= '*') $ concat $ generateMineField xs
    
-- Implementation
type Point = (Integer,Integer)

data MineField = MineField Integer Integer [Point] 

generateMineField :: [String] -> [String]
generateMineField = renderMineField . mkMineField . labelCharacters

labelCharacters :: [String] -> [(Point,Char)]
labelCharacters = concatMap (uncurry labelCols) . labelRows
  where
    labelRows = zip [0..]
    labelCols row = zipWith (\col x -> ((row,col), x)) [0..]

mkMineField :: [(Point,Char)] -> MineField
mkMineField xs = MineField width height mines
  where
    ((width,height),_) = maximumBy (comparing fst) xs
    mines = map fst $ filter ((== '*') . snd) xs

renderMineField :: MineField -> [String]
renderMineField (MineField w h ms) =
  map (\y -> [renderPoint ms (y,x) | x <- [0..h] ]) [0..w]

neighbours :: Point -> [Point] -> Int
neighbours m ms = length $ filter (neighbour m) $ delete m ms
  where
    neighbour (a,b) (c,d) = abs (a - c) <= 1 && abs (b - d) <= 1

renderPoint :: [Point] -> Point -> Char
renderPoint ms m
  | m `elem` ms = '*'
  | otherwise   = intToDigit (neighbours m ms)