min/max algorithm for coins game

coins.hs

-- Simple min/max algorithm playing a game with coins
--
-- Rules:
-- > Initially, there is a stack of N coins
-- > Players take 1, 2 or 3 coins
-- > The player who takes the last coin loses

import Data.List (maximumBy, minimumBy)
import Data.Ord (comparing)
import System.IO

type GameState = (Int, Player)
type Score = Int
data Player = Max | Min

next :: Player -> Player
next Max = Min
next Min = Max

moves :: Int -> [Int]
moves n = take 3 [1 .. n]

gamestates :: GameState -> [GameState]
gamestates (n, pl) = map (\taken -> (n - taken, next pl)) (moves n)

-- | The actual min/max algorithm
-- Score = 1 : Max wins
-- Score = 0 : Min wins
score :: GameState -> Score
score (0, Max) = 1 -- Min had to take the last coin
score (0, Min) = 0
score (n, pl)  = score $ fn pl (comparing score) (gamestates (n, pl))
    where fn Max = maximumBy
          fn Min = minimumBy


-- I/O stuff for fun --

showCoins :: Int -> IO ()
showCoins n = putStrLn $ replicate n '#' ++ " (" ++ show n ++ ")"

play :: GameState -> IO ()
play (0, Min) = putStrLn "You win.."
play (0, Max) = putStrLn "I win .. again!"
play (n, Min) = do
    putStrLn ""
    showCoins n
    putStr "How many coins do you take? "
    hFlush stdout
    coins <- readLn
    if coins < 1 || coins > min 3 n
    then putStrLn "You are cheating.. I give up"
    else play (n - coins, Max)
play (n, Max) = do
    let (n', _) = maximumBy (comparing score) (gamestates (n, Max))
    putStrLn ""
    showCoins n
    putStrLn $ "I take " ++ show (n - n') ++ " coin(s)"
    play (n', Min)

main = do
    putStr "Number of coins: "
    hFlush stdout
    coins <- readLn

    let initial = (coins, Max)

    putStrLn $
        if score initial == 1
        then "I predict that I will win..."
        else "You have a fair chance to win this one"

    play initial