mastermind.hs

import System.Random
import Data.List

---------------------------------------------------------------------
-- run this function to play
mastermind :: IO ()
mastermind = do
    putStrLn ""
    p1 <- randPeg; p2 <- randPeg; p3 <- randPeg; p4 <- randPeg
    let code = p1 ++ p2 ++ p3 ++ p4
    play code 12
---------------------------------------------------------------------
randPeg :: IO String
randPeg = do
  i <- getStdRandom (randomR (1::Int, 6))
  return $ show i
---------------------------------------------------------------------
play :: String -> Int -> IO ()
play code turns =
  if turns == 0
    then do
      putStrLn $ "You lost, the secret code was: " ++ code ++ "\n"
      playAgain
    else do
      putStrLn $ "You have " ++ show turns ++ " guesses remaining."
      putStrLn "Enter guess - ( 4 chars chosen from 123456 )"
      guess <- ioStr "123456" 4
      let s = score guess code
      putStrLn $ "\nGuess: " ++ guess ++ " scores: " ++ showScore s
      putStrLn ""
      if s < 20
        then play code (turns - 1)
        else do putStrLn "You guessed right !!!\n"
                playAgain
---------------------------------------------------------------------
playAgain :: IO ()
playAgain = do
    putStr "Play again ? (y/n): "
    ans <- ioChar "yn"
    putStrLn ""
    if ans == 'y' then mastermind else putStrLn "Goodbye.\n"
---------------------------------------------------------------------
-- convert int score to string e.g 7 -> Black-White-White
showScore :: Int -> String
showScore n =
  let s = replicate (n `div` 5) "Black" ++ replicate (n `mod` 5) "White"
  in if null s then "Nothing" else intercalate "-" s
---------------------------------------------------------------------
-- score guess with code: 5 = black, 1 = white
-- e.g. score "1234" "1346" = 7 which means 1 Black & 2 Whites
score :: String -> String -> Int
score guess code =
  let
    guessPermutations = permutations $ zip guess [0..]
    scoreWith c = sum . zipWith scorePeg (zip c [0..])
    scorePeg (x,i)(y,j) = if x == y then if i == j then 5 else 1 else 0
  in
    maximum $ map (scoreWith code) guessPermutations
----------------------------------------------------------------------
ioChar :: [Char] -> IO Char
ioChar cs = do c <- getChar
               if c `elem` cs then return c else ioChar cs
----------------------------------------------------------------------
ioStr :: [Char] -> Int -> IO String
ioStr cs len = if len == 0 then return "" else do
    c   <- ioChar cs
    cs' <- ioStr  cs (len - 1)
    return (c : cs')
----------------------------------------------------------------------

typical output:

*Main> mastermind

You have 12 guesses remaining.
Enter guess - ( 4 chars chosen from 123456 e.g. 3134 )
1122
Guess: 1122 scores: Black-Black-Black
You have 11 guesses remaining.
Enter guess - ( 4 chars chosen from 123456 e.g. 3134 )
1111
Guess: 1111 scores: Black
You have 10 guesses remaining.
Enter guess - ( 4 chars chosen from 123456 e.g. 3134 )
3344
Guess: 3344 scores: Black
You have 9 guesses remaining.
Enter guess - ( 4 chars chosen from 123456 e.g. 3134 )
1322
Guess: 1322 scores: Black-Black-White-White
You have 8 guesses remaining.
Enter guess - ( 4 chars chosen from 123456 e.g. 3134 )
3122
Guess: 3122 scores: Black-Black-Black-Black
You guessed right !!!

Play again ? (y/n): n
Goodbye.