src/Mine.hs

   1 -- |
   2 -- Module      : Mine
   3 -- Copyright   : (c) 2008 Bertram Felgenhauer
   4 -- License     : BSD3
   5 --
   6 -- Maintainer  : Bertram Felgenhauer <int-e@gmx.de>
   7 -- Stability   : experimental
   8 -- Portability : portable
   9 --
  10 -- This module is part of Haskell PGMS.
  11 --
  12 -- It provides types and a monad for implementing and running Minesweeper
  13 -- strategies. It's the core of PGMS.
  14 --
  15
  16 module Mine (
  17     -- * Minesweeper configurations
  18     Config (..),
  19     validConfig,
  20     beginner,
  21     intermediate,
  22     expert,
  23     -- * Minesweeper boards
  24     Pos (..),
  25     Cell (..),
  26     Board (..),
  27     View,
  28     neighbours,
  29     -- * Minesweeper strategies
  30     StrategyM,
  31     Strategy (..),
  32     defaultStrategy,
  33     move,
  34     move_,
  35     mark,
  36     getView,
  37     getConfig,
  38     traceMine,
  39     -- * Running Minesweeper games
  40     Result (..),
  41     playGame,
  42     Play (..),
  43     playGameP,
  44 ) where
  45
  46 import Control.Monad.Prompt
  47 import Control.Monad.State
  48 import Data.Array.IArray
  49 import Data.Array.Unboxed
  50 import System.Random
  51
  52 -- | A point in 2D space with integer coordinates.
  53 --
  54 -- Used to adress cells on a Minesweeper board, and also to describe board
  55 -- sizes.
  56 data Pos = Pos { pX :: Int, pY :: Int } deriving (Show, Ord, Eq, Ix)
  57
  58 -- | A cell on a Minesweeper board.
  59 data Cell = Hidden              -- ^ a hidden cell
  60           | Marked              -- ^ a marked cell
  61           | Exploded            -- ^ oops, you stepped on a mine here!
  62           | Exposed Int         -- ^ an exposed cell with a count of neighbours
  63     deriving (Eq, Show)
  64
  65 -- | A view of the Minesweeper board.
  66 type View = Array Pos Cell
  67
  68 -- | A complete Minesweeper board, including hidden state.
  69 data Board = Board {
  70     bConfig :: Config,          -- ^ board size etc.
  71     bMines  :: Array Pos Bool,  -- ^ array indicating the position of the mines
  72     bView   :: View,            -- ^ current view
  73     bTodo   :: Int              -- ^ number of mines left to find
  74 }
  75
  76 instance Show Board where
  77     show Board { bConfig = Config { cSize = p }, bMines = b, bView = v } =
  78         '\n' : unlines [ "|" ++ concat [cell (Pos x y) | x <- [1..pX p]] ++ " |"
  79                        | y <- [1..pY p]]
  80       where
  81         cell p | b ! p     = case v ! p of
  82                    Hidden    -> " :"
  83                    Marked    -> " X"
  84                    Exploded  -> ">%"
  85                | otherwise = case v ! p of
  86                    Hidden    -> " ."
  87                    Marked    -> " !"
  88                    Exposed 0 -> "  "
  89                    Exposed i -> ' ' : toEnum (48 + i) : ""
  90
  91 -- | Description of a mine sweeper configuration (or difficulty).
  92 data Config = Config {
  93     cSize  :: Pos,              -- ^ the board size
  94     cMines :: Int               -- ^ the number of mines placed on the board
  95 } deriving (Eq, Show)
  96
  97 -- | Check validity of a config.
  98 --
  99 -- The width and height must be at least 2, and the number of mines must be
 100 -- between 1 and the number of cells on the board, minus 1.
 101 validConfig :: Config -> Bool
 102 validConfig Config { cSize = sz@(Pos sX sY), cMines = m } =
 103     sX >= 2 && sY >= 2 && m >= 1 && m < sX * sY
 104
 105 -- | Default config: 9x9 with 10 mines
 106 beginner     :: Config
 107 beginner     = Config { cSize = Pos  9  9, cMines = 10 }
 108
 109 -- | Default config: 16x16 with 40 mines
 110 intermediate :: Config
 111 intermediate = Config { cSize = Pos 16 16, cMines = 40 }
 112
 113 -- | Default config: 30x16 with 99 mines
 114 expert       :: Config
 115 expert       = Config { cSize = Pos 30 16, cMines = 99 }
 116
 117 -- Create a random board according to the given config.
 118 mkBoard :: Config -> StdGen -> Board
 119 mkBoard cfg@Config { cSize = sz@(Pos sX sY), cMines = m } gen
 120     | not (validConfig cfg) = error "invalid mine config"
 121     | otherwise = Board {
 122          bConfig = cfg,
 123          bView   = listArray (Pos 1 1, sz) (repeat Hidden),
 124          bMines  = listArray (Pos 1 1, sz) (pick gen (sX * sY) m),
 125          bTodo   = sX * sY - m
 126     }
 127   where
 128     pick gen n m | r <= m    = True  : pick gen' (n-1) (m-1)
 129                  | otherwise = False : pick gen' (n-1) m
 130       where
 131         (r, gen') = randomR (1, n) gen
 132
 133 -- | Find the neighbouring cells of a given cell.
 134 --
 135 -- The 'Config' parameter is used to find the boundaries of the board.
 136 neighbours :: Config -> Pos -> [Pos]
 137 neighbours Config { cSize = Pos sX sY } (Pos x y) =
 138     [ Pos (x + dx) (y + dy)
 139     | dx <- if x == 1 then [0..1] else if x == sX then [-1..0] else [-1..1],
 140       dy <- if y == 1 then [0..1] else if y == sY then [-1..0] else [-1..1],
 141       dx /= 0 || dy /= 0]
 142
 143 -- count the mines in the neighbourhood of the given cell
 144 mines :: Board -> Pos -> Int
 145 mines Board { bConfig = cfg, bMines = m } =
 146     length . filter (m !) . neighbours cfg
 147
 148 data Request a where
 149     Move      :: Pos -> Request Int
 150     Mark      :: Pos -> Request ()
 151     GetView   :: Request View
 152     GetConfig :: Request Config
 153     TraceMine :: String -> Request ()
 154
 155 -- | The monad for implementing Minesweeper strategies.
 156 newtype StrategyM a = StrategyM {
 157     runStrategyM :: Prompt Request a
 158 } deriving Monad
 159
 160 -- | Reveal a cell. Returns the number of mines in the neighbourhood.
 161 --
 162 -- Note: Revealing a cell with a mine beneath will lose the game.
 163 move :: Pos -> StrategyM Int
 164 move = StrategyM . prompt . Move
 165
 166 -- | Like 'move', but with no return value.
 167 move_ :: Pos -> StrategyM ()
 168 move_ = (>> return ()) . move
 169
 170 -- | Mark a cell.
 171 --
 172 -- Note: Marking a cell without a mine beneath will lose the game. This is
 173 -- a deviation from standard Minesweeper.
 174 mark :: Pos -> StrategyM ()
 175 mark = StrategyM . prompt . Mark
 176
 177 -- | Get a view of the current board.
 178 getView :: StrategyM View
 179 getView = StrategyM (prompt GetView)
 180
 181 -- | Get the current board's config.
 182 --
 183 -- Note: the config will never change throughout a game.
 184 getConfig :: StrategyM Config
 185 getConfig = StrategyM (prompt GetConfig)
 186
 187 -- | Provide a debug message.
 188 --
 189 -- These will be displayed in the status line in the GUI or on the
 190 -- terminal when running the command line version in verbose mode.
 191 traceMine :: String -> StrategyM ()
 192 traceMine = StrategyM . prompt . TraceMine
 193
 194 -- | A game result.
 195 data Result a = Won             -- ^ The game was won.
 196               | Unfinished a    -- ^ The strategy implementation finished
 197                                 --   before the game was over.
 198               | Lost            -- ^ The game was lost.
 199     deriving (Show, Eq)
 200
 201 -- | A strategy with some meta-information.
 202 --
 203 -- It's advisable to define your own strategies in terms of 'defaultStrategy'
 204 -- so that future additions to that record don't break your code.
 205 data Strategy = Strategy {
 206     sName        :: String,     -- ^ The strategy's name. It should be ASCII
 207                                 --   and not contain spaces.
 208     sAuthor      :: String,     -- ^ The strategy's author.
 209     sDescription :: String,     -- ^ A description of the strategy.
 210     sRun         :: StdGen -> StrategyM String
 211                                 -- ^ The strategy's implementation.
 212 }
 213
 214 -- | Default values for 'Strategy'.
 215 --
 216 -- > myStrategy :: Strategy
 217 -- > myStrategy = defaultStrategy {
 218 -- >     sName = "Hiho",
 219 -- >     sRun  = \_ -> return "I don't want to play anymore, see you!"
 220 -- > }
 221 defaultStrategy :: Strategy
 222 defaultStrategy = Strategy {
 223     sName        = "<unknown strategy>",
 224     sAuthor      = "<unknown author>",
 225     sDescription = "This strategy has no description.",
 226     sRun         = \_ -> return "<unimplemented strategy>"
 227 }
 228
 229 -- | UI interface
 230 --
 231 -- These are actions for the 'MonadPrompt' monad.
 232 --
 233 --  * 'Start'  - A new game just started.
 234 --
 235 --  * 'Update' - A move was made, and the indicated cell changed
 236 --
 237 --  * 'Trace'  - The strategy provided a trace message.
 238 --
 239 data Play a where
 240     Start  :: Board -> Play ()  -- (^  A new game just started.
 241     Update :: Pos -> Board -> Play ()
 242                                 -- (^  A move was made, and the indicated cell
 243                                 --   changed
 244     Trace  :: String -> Board -> Play ()
 245                                 -- (^  The strategy provided a trace message.
 246
 247 -- internally, we work in this monad.
 248 type PlayM a = StateT Board (Prompt Play) (Result a)
 249
 250 -- | Play a game.
 251 --
 252 -- The result is a 'Prompt' action, which is suitable for implementing
 253 -- a UI that displays the game's progress.
 254 playGameP :: Config -> StdGen -> StrategyM a -> Prompt Play (Result a, Board)
 255 playGameP cfg gen strategy = runStateT (game strategy) (mkBoard cfg gen)
 256   where
 257     game :: StrategyM a -> PlayM a
 258     game strategy = do
 259         get >>= lift . prompt . Start
 260         runPromptC (return . Unfinished) handle (runStrategyM strategy)
 261
 262     handle :: Request p -> (p -> PlayM a) -> PlayM a
 263     handle GetView    cont = gets bView   >>= cont
 264     handle GetConfig  cont = gets bConfig >>= cont
 265     handle (Move p)   cont = do
 266         b@Board { bMines = bm, bView = bv, bTodo = bt } <- get
 267         if bm ! p then do put b { bView = bv // [(p, Exploded)] }
 268                           get >>= lift . prompt . Update p
 269                           return Lost
 270          else case bv ! p of
 271             Exposed i -> cont i
 272             _         -> do let n = mines b p
 273                             put b { bView = bv // [(p, Exposed n)],
 274                                     bTodo = bt - 1 }
 275                             get >>= lift . prompt . Update p
 276                             if bt == 1 then return Won else cont n
 277     handle (Mark p) cont = do
 278         b@Board { bMines = bm, bView = bv } <- get
 279         when (bv ! p == Hidden) $ do
 280             put b { bView = bv // [(p, Marked)] }
 281             get >>= lift . prompt . Update p
 282         if bm ! p then
 283             cont ()
 284          else
 285             return Lost
 286     handle (TraceMine s) cont = get >>= lift . prompt . Trace s >> cont ()
 287
 288 -- | A pure version of 'playGameP'.
 289 playGame :: Config -> StdGen -> StrategyM a -> (Result a, Board)
 290 playGame cfg gen strat = runPrompt handle (playGameP cfg gen strat) where
 291      handle :: Play a -> a
 292      handle Start {}    = ()
 293      handle Update {}   = ()
 294      handle (Trace s b) = ()
 295
 296 {-
 297 example won game:
 298 playGame True beginner (mkStdGen 164806687) (mark (Pos 9 1) >> mark (Pos 3 4) >> mark (Pos 5 4) >> mark (Pos 1 5) >> mark (Pos 5 5) >> mark (Pos 9 5) >> mark (Pos 1 8) >> mark (Pos 3 8) >> mark (Pos 8 8) >> mark (Pos 3 9) >> getView >>= \l -> sequence [move p | (p, Hidden) <- assocs l])
 299 -}