Skip to content

Instantly share code, notes, and snippets.

@isomorphism
Created January 10, 2012 09:24
Show Gist options
  • Save isomorphism/1588045 to your computer and use it in GitHub Desktop.
Save isomorphism/1588045 to your computer and use it in GitHub Desktop.
Code review
-- Suggested changes for http://codereview.stackexchange.com/q/7623/4949
module Nim where
import Data.List
import Data.Maybe
import qualified Data.Map as Map
--Domain
--Nim is a mathematical game of strategy
--in which two players take turns removing objects from distinct heaps.
--On each turn, a player must remove at least one object, and may remove
--any number of objects provided they all come from the same heap.
--Read more at http://en.wikipedia.org/wiki/Nim
--
type HeapId = Integer
type Turn = (HeapId, Integer)
type Board = Map.Map HeapId Integer
applyTurn :: Board -> Turn -> Board
applyTurn board (heapId, removed) = Map.adjust (subtract removed) heapId board
empty :: Board -> Bool
empty b = Map.null $ availableHeaps b
availableHeaps :: Board -> Board
availableHeaps b = Map.filter (> 0) b
-- Pretty-printing for board showing object counts visually.
showHeaps :: Board -> [String]
showHeaps board = map showIdxHeap (Map.assocs board)
showIdxHeap :: (HeapId, Integer) -> String
showIdxHeap (heapId, n) = concat ["[", show heapId, "]", genericReplicate n '*']
--IO Utils
--
-- Why doesn't this exist in the Prelude?
maybeRead :: (Read a) => String -> Maybe a
maybeRead str = listToMaybe [x | (x, "") <- reads str]
maybeReadLn :: (Read a) => IO (Maybe a)
maybeReadLn = fmap maybeRead getLine
-- Read integer from console, validated with the supplied predicate.
promptInt :: String -> (Integer -> Bool) -> IO Integer
promptInt msg p = do
putStr (msg ++ "> ")
mx <- maybeReadLn
case mx of
Just x | p x -> return x
_ -> promptInt msg p
-- Read integer from console, limited to the given range.
promptIntFromRange :: String -> (Integer, Integer) -> IO Integer
promptIntFromRange msg (from, to) = promptInt msg' inRange
where msg' = concat [msg, "[", show from, ";", show to, "]"]
inRange v = v >= from && v <= to
-- Read heap number from console and lookup object count.
promptHeapSize :: String -> Board -> IO (HeapId, Integer)
promptHeapSize msg board = do
heapId <- promptInt (msg ++ show (Map.keys board)) (`Map.member` board)
case Map.lookup heapId board of
Nothing -> promptHeapSize msg board
Just sz -> return (heapId, sz)
--Game specific IO
--
-- Prompt user and update board for current turn.
runNextTurn :: Board -> IO Board
runNextTurn board = do
printBoard board
fmap (applyTurn board) (readTurn board)
-- Dialog for inputing turn data.
readTurn :: Board -> IO Turn
readTurn b = do
(heapId, heapSz) <- promptHeapSize "heap" b
objects <- promptIntFromRange "number" (1, heapSz)
return (heapId, objects)
-- Print board in user friendly interface.
printBoard :: Board -> IO ()
printBoard board = mapM_ putStrLn $ showHeaps board
--Game
--
--Actually game.
play :: Board -> IO Board
play board | empty board = return board
| otherwise = runNextTurn board >>= play
--Runner function.
nim :: IO ()
nim = do play $ Map.fromList (zip [1..] [1, 2, 3, 1])
putStrLn "done"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment