Code review

Nim.hs

-- 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"