Advertisement
Guest User

Untitled

a guest
Feb 28th, 2023
95
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.53 KB | None | 0 0
  1. module Main where
  2.  
  3. import System.Random (randomRIO)
  4. import System.IO (stdout, hSetBuffering, BufferMode (..))
  5. import Data.Char (isDigit, toLower, digitToInt)
  6. import Data.Functor ((<$))
  7. import Data.List (intercalate)
  8.  
  9. -- Assets
  10.  
  11. introText :: String
  12. introText = "\
  13. \Bagels, a deductive logic game.\n\
  14. \By Al Sweigart al@inventwithpython.com\n\
  15. \Haskell version by Liam Zhu\n\
  16. \\n\
  17. \I am thinking of a 3-digit number. Try to guess what it is.\n\
  18. \Here are some clues:\n\
  19. \When I say: That means:\n\
  20. \ Pico One digit is correct, but in the wrong position.\n\
  21. \ Fermi One digit is correct, and in the right position.\n\
  22. \ Bagels No digit is correct.\n"
  23.  
  24. gameStartText :: String
  25. gameStartText = "\
  26. \I have thought up a number.\n\
  27. \ You have 10 guesses to get it.\n"
  28.  
  29. -- end Assets
  30.  
  31. main :: IO ()
  32. main = do
  33. hSetBuffering stdout NoBuffering
  34. putStrLn introText
  35. bagel
  36.  
  37. bagel :: IO ()
  38. bagel = do
  39. putStrLn gameStartText
  40. secretNumbers <- traverse (const $ randomRIO (0,9)) [1..3]
  41. loopGuessesPrompt secretNumbers 1
  42. newGamePrompt
  43.  
  44. loopGuessesPrompt :: [Int] -> Int -> IO ()
  45. loopGuessesPrompt [firstNumber, secondNumber, thirdNumber] 11 = do
  46. putStrLn "You ran out of guesses."
  47. putStrLn $ "The answer was "
  48. <> (foldMap show [firstNumber, secondNumber, thirdNumber]) <> "."
  49. loopGuessesPrompt secretNumber n = do
  50. putStrLn $ "Guess #" <> show n <> ":"
  51. putStr "> "
  52. getLine >>= loopEvaluateLine n secretNumber
  53.  
  54. loopEvaluateLine :: Int -> [Int] -> String -> IO ()
  55. loopEvaluateLine triesSoFar secretNumber guess
  56. | 3 /= length guess || any (not . isDigit) guess =
  57. loopGuessesPrompt secretNumber triesSoFar
  58. | convertedNumber == ["Fermi", "Fermi", "Fermi"] =
  59. putStrLn "You got it!"
  60. | null $ concat convertedNumber = putStrLn "Bagels" >> loopGuessesPrompt secretNumber (succ triesSoFar)
  61. | otherwise =
  62. putStrLn (intercalate " " (filter (not . null) convertedNumber)) >> loopGuessesPrompt secretNumber (succ triesSoFar)
  63. where
  64. parsedGuess = digitToInt <$> guess
  65.  
  66. convertedNumber =
  67. fermis <> picos
  68.  
  69. fermis = "Fermi" <$ filter (\(a,b) -> a == b) groups
  70.  
  71. groups = zip parsedGuess secretNumber
  72.  
  73. picos = "Pico" <$ filter (\(a,b) -> a /= b && a `elem` secretNumber) groups
  74.  
  75. newGamePrompt :: IO ()
  76. newGamePrompt = do
  77. putStrLn "Do you want to play again? (yes or no)"
  78. putStr "> "
  79. fmap toLower <$> getLine >>= \case
  80. 'y':xs -> bagel
  81. _ -> pure ()
  82.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement