module Main where import Data.Char (toLower) import Data.Maybe (isJust) import Data.List (intersperse) import System.Exit (exitSuccess) import System.Random (randomRIO) type WordList = [String] minWordLength :: Int minWordLength = 5 maxWordLength :: Int maxWordLength = 9 allWords :: IO WordList allWords = lines <$> readFile "data/dict.txt" gameWords :: IO WordList gameWords = filter gameLength <$> allWords where gameLength :: String -> Bool gameLength w = let l = length w in l >= minWordLength && l < maxWordLength randomWord :: WordList -> IO String randomWord wl = (wl !!) <$> randomRIO (0, length wl - 1) randomWord' :: IO String -- Seriously, shitty naming randomWord' = gameWords >>= randomWord data Puzzle = Puzzle { answer :: String, discovered :: [Maybe Char], guessed :: [Char] } instance Show Puzzle where show puzzle = (intersperse ' ' $ fmap renderPuzzleChar (discovered puzzle)) ++ " Guessed so far: " ++ (intersperse ',' $ guessed puzzle) renderPuzzleChar :: Maybe Char -> Char renderPuzzleChar Nothing = '_' renderPuzzleChar (Just c) = c makePuzzle :: String -> Puzzle makePuzzle ans = Puzzle { answer = ans, discovered = map (const Nothing) ans, guessed = [] } charInAnswer :: Char -> Puzzle -> Bool charInAnswer c = elem c . answer alreadyGuessed :: Char -> Puzzle -> Bool alreadyGuessed c = elem c . guessed fillInCharacter :: Char -> Puzzle -> Puzzle fillInCharacter c puzzle = puzzle { discovered = afterFill, guessed = c : (guessed puzzle) } where zipper guess ansChar discov = if ansChar == guess then Just ansChar else discov afterFill = zipWith (zipper c) (answer puzzle) (discovered puzzle) handleGuess :: Char -> Puzzle -> IO (Puzzle, Bool) handleGuess guess puzzle = case (charInAnswer guess puzzle, alreadyGuessed guess puzzle) of (_, True) -> do putStrLn "You already guess that! Pick something else!" return (puzzle, True) (True, _) -> do putStrLn "This character was in the answer." return (fillInCharacter guess puzzle, True) (False, _) -> do putStrLn "This character wasn't in the answer." return (fillInCharacter guess puzzle, False) maxFails :: Int maxFails = 7 gameOver :: String -> IO () gameOver ans = do putStrLn "You lost!" putStrLn $ "The word was: " ++ ans exitSuccess gameWin :: IO () gameWin = putStrLn "You won!" >> exitSuccess runGame :: Int -> Puzzle -> IO () runGame fails puzzle | fails > maxFails = gameOver (answer puzzle) | all isJust (discovered puzzle) = gameWin | otherwise= do putStrLn "[ CURRENT PUZZZLE ]" print puzzle putStrLn $ "Fails so far: " ++ show fails putStr "Guess a letter: " guess <- getLine case guess of [c] -> handleGuess c puzzle >>= nextTurn _ -> putStrLn "Invalid input, guess must be a single character." where nextTurn (newPuzzle, True) = putStrLn "" >> runGame fails newPuzzle nextTurn (newPuzzle, False) = putStrLn "" >> runGame (succ fails) newPuzzle main :: IO () main = makePuzzle . map toLower <$> randomWord' >>= runGame 0


Haskell Programming from First Principles 하다가 입맛에 안 맞는 부분 고쳐서 짜 봤어요

많이 혼내주세요