Last active
September 29, 2016 10:16
-
-
Save buscarini/c06f52c4044d57c8cfe6970741aeb9b7 to your computer and use it in GitHub Desktop.
Mastermind game in Haskell
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Mastermind | |
where | |
import System.Random | |
import Text.Read | |
import Data.Maybe | |
import Data.Char | |
data Color = Red | Green | Blue | Yellow | Brown | Orange | Black | White deriving (Show, Read, Eq, Ord, Bounded, Enum) | |
type Combination = [Color] | |
boolToInt x = if x then 1 else 0 | |
checkWhites:: Combination -> Combination -> Int | |
checkWhites secret guess = | |
sum $ fmap boolToInt $ fmap (\x -> x `elem` secret) guess | |
checkBlacks:: Combination -> Combination -> Int | |
checkBlacks secret guess = | |
let pairs = zip secret guess in | |
sum $ fmap boolToInt $ [ x == y | (x,y) <- pairs] | |
check:: Combination -> Combination -> (Int, Int) | |
check secret guess = let blacks = checkBlacks secret guess in | |
(checkWhites secret guess -blacks, blacks) | |
parse:: String -> Maybe Combination | |
parse x = sequence $ fmap (\x -> readMaybe ((toUpper $ head x) : tail x) :: Maybe Color) (words x) | |
guess:: Combination -> Int -> Combination -> IO () | |
guess secret moves guess = do | |
let (whites, blacks) = check secret guess | |
if blacks == length secret then | |
putStrLn "You win! 🎉" | |
else do | |
putStrLn ("Result: " ++ show whites ++ " whites " ++ show blacks ++ " blacks. Moves " ++ show (moves-1)) | |
turn secret (moves-1) | |
takeNoRepeats:: (Eq a) => Int -> [a] -> [a] -> [a] | |
takeNoRepeats n [] [] = [] | |
takeNoRepeats 0 x y = x | |
takeNoRepeats n x (y:t) | |
| y `elem` x = takeNoRepeats n x t | |
| otherwise = let taken = | |
x ++ [y] | |
in (takeNoRepeats (n-1) taken t) | |
mkguess:: Combination -> Int -> IO () | |
mkguess secret moves = do | |
putStrLn "\nEnter a guess:" | |
string <- getLine | |
let userGuess = parse string | |
if isJust userGuess then | |
guess secret moves (fromJust userGuess) | |
else | |
turn secret moves | |
randomInList:: StdGen -> [a] -> [a] | |
randomInList gen allVals = let results = (randomRs (0, (length allVals -1)) gen) | |
in | |
[ allVals !! x | x <- results ] | |
turn:: Combination -> Int -> IO () | |
turn secret moves = if moves == 0 then | |
print $ "You lose. 😭" ++ show secret | |
else mkguess secret moves | |
mastermind:: Int -> Int -> IO() | |
mastermind len moves = do | |
gen <- newStdGen | |
let allColors = [ Red .. White] | |
putStrLn $ "Available colors: " ++ (show allColors) | |
let secret = takeNoRepeats len [] $ randomInList gen allColors | |
in do -- print secret | |
turn secret moves | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment