7
\$\begingroup\$

I've been learning Haskell, and a while ago I created this Hangman game. I've been working on using a library for terminal output, so no more hardcoded escape codes, but in the meantime I'd like some comments on what I have until now.

Is this readable, correct Haskell code with no obvious performance problems?

The code depends on a file being present named after the language (EN or NL) containing linebreak-separated words that is easily created.

import System.Random (randomRIO)
import Data.Char (isAlpha, toUpper)
import Data.List (intersperse)
import System.IO (hSetBuffering, stdin, BufferMode (NoBuffering) )

lang = EN

main :: IO ()
main = do hSetBuffering stdin NoBuffering
          f <- readFile $ show lang
          startplaying $ lines f

startplaying :: [String] -> IO ()
startplaying words = do index <- randomRIO (0,length words - 1)
                        playgame (words !! index) []
                        putStrLn $ strings lang Another
                        ans   <- getChar
                        case ans of
                           'n' -> return ()
                           _   -> startplaying words

playgame :: String -> [Char] -> IO ()
playgame word guessed
  | complete                                       = printState word guessed Won ""
  | guessedwrong word guessed >= length hangman -1 = printState word guessed Lost word
  | otherwise                                      = do printState word guessed Pick ""
                                                        l <- fmap toUpper getChar
                                                        let guessed' | not (isAlpha l)  = guessed
                                                                     | l `elem` guessed = guessed
                                                                     | otherwise        = l : guessed
                                                        playgame word guessed'
  where complete :: Bool
        complete = all (`elem` guessed) (map toUpper word)

guessedwrong :: String -> [Char] -> Int
guessedwrong word guessed = length $ filter (`notElem` map toUpper word) guessed

printState :: String -> [Char] -> Message -> String -> IO ()
printState word guessed message string = putStrLn $ "\ESC[2J" ++
                                  unlines [ hangman !! (guessedwrong word guessed)
                                          , map (\x -> if (elem (toUpper x) guessed) then x else '_') word
                                          , (strings lang Used) ++ intersperse ' ' guessed
                                          , strings lang message ++ string
                                          ]

strings :: Language -> Message -> String
strings NL m = case m of
                  Another -> "Wil je nog een keer spelen? [Y/n]"
                  Won     -> "Gefeliciteerd! Je hebt het woord geraden!"
                  Lost    -> "Je bent dood. Het woord was "
                  Pick    -> "Kies een letter"
                  Used    -> "Gebruikte letters: "
strings EN m = case m of
                  Another -> "Play another game? [Y/n]"
                  Won     -> "Congratulations! You got it!"
                  Lost    -> "You're dead. The word was "
                  Pick    -> "Pick a letter"
                  Used    -> "Used letters: "

data Message = Another | Won | Lost | Pick | Used

data Language = NL
              | EN
              deriving (Show)

hangman = [ unlines  [ ""
                     , ""
                     , ""
                     , ""
                     , ""
                     , ""
                     , ""
                     , ""
                     ]
          , unlines  [ ""
                     , ""
                     , ""
                     , ""
                     , ""
                     , ""
                     , ""
                     , " ___"
                     ]
          , unlines  [ ""
                     , "|"
                     , "|"
                     , "|"
                     , "|"
                     , "|"
                     , "|"
                     , "|___"
                     ]
          , unlines  [ "_________"
                     , "|"
                     , "|"
                     , "|"
                     , "|"
                     , "|"
                     , "|"
                     , "|___"
                     ]
          , unlines  [ "_________"
                     , "|/"
                     , "|"
                     , "|"
                     , "|"
                     , "|"
                     , "|"
                     , "|___"
                     ]
          , unlines  [ "_________"
                     , "|/       |"
                     , "|"
                     , "|"
                     , "|"
                     , "|"
                     , "|"
                     , "|___"
                     ]
          , unlines  [ "_________"
                     , "|/       |"
                     , "|       (_)"
                     , "|"
                     , "|"
                     , "|"
                     , "|"
                     , "|___"
                     ]
          , unlines  [ "_________"
                     , "|/       |"
                     , "|       (_)"
                     , "|        |"
                     , "|        |"
                     , "|"
                     , "|"
                     , "|___"
                     ]
          , unlines  [ "_________"
                     , "|/       |"
                     , "|       (_)"
                     , "|       /|"
                     , "|        |"
                     , "|"
                     , "|"
                     , "|___"
                     ]
          , unlines  [ "_________"
                     , "|/       |"
                     , "|       (_)"
                     , "|       /|\\"
                     , "|        |"
                     , "|"
                     , "|"
                     , "|___"
                     ]
          , unlines  [ "_________"
                     , "|/       |"
                     , "|       (_)"
                     , "|       /|\\"
                     , "|        |"
                     , "|       /"
                     , "|"
                     , "|___"
                     ]
          , unlines  [ "_________"
                     , "|/       |"
                     , "|       (_)"
                     , "|       /|\\"
                     , "|        |"
                     , "|       / \\"
                     , "|"
                     , "|___"
                     ]
          ]
\$\endgroup\$
4
  • 2
    \$\begingroup\$ startplaying words = do index <- randomRIO (0,length words) should be startplaying words = do index <- randomRIO (0,length words - 1) so you don't go off the end of the list. \$\endgroup\$
    – AndrewC
    Nov 13, 2012 at 23:06
  • 1
    \$\begingroup\$ Consider failing with a more helpful message if the language-specific file isn't there, perhaps as part of allowing the user to choose the language at start up. \$\endgroup\$
    – AndrewC
    Nov 13, 2012 at 23:09
  • 1
    \$\begingroup\$ It suffers from the getChar bug in ghc under windows (but is OK in WinHugs, and the fix causes a bug in WinHugs). This might not matter to you. See this stack overflow question \$\endgroup\$
    – AndrewC
    Nov 13, 2012 at 23:16
  • \$\begingroup\$ @AndrewC: Thank you. I fixed the off-by-one error (d'oh). I was planning on making the language selectable as part of separating the UI code and using a terminal library. I'm aware of the Windows bug, but since this is just a toy program I didn't really worry about it. \$\endgroup\$ Nov 14, 2012 at 15:49

1 Answer 1

3
\$\begingroup\$

Why do you have so much redundant data in State? That just means you have to put a lot of effort into keeping everything up-to-date - which doesn't just make your program longer, but is also prone to mistakes.

By eliminating all redundancy as well as replacing the explicit state variable by control flow, the playgame function can be simplified down to pretty much the following:

count_duds :: String -> [Char] -> Int
count_duds word guessed = length $ filter (`notElem` map toUpper word) guessed

playgame :: String -> [Char] -> IO ()
playgame word guessed
  | all (`elem` guessed) (map toUpper word)       = putStrLn $ header "Won"
  | count_duds word guessed + 1 >= length hangman = putStrLn $ header "Lost" ++ word
  | otherwise = do putStrLn $ header "Pick"
                   l <- fmap toUpper getChar
                   let guessed' | not (isAlpha l)  = guessed
                                | l `elem` guessed = guessed
                                | otherwise        = l:guessed
                   playgame word guessed'
  where header msg = formatState word guessed ++ "\n" ++ strings lang msg

Admittedly, this does quite a bit of re-computation, especially on the "duds". Yet we can probably expect both words and game lengths to be small, therefore it is better to go with a more compact program.

\$\endgroup\$
1
  • \$\begingroup\$ Thank you! I agree, my version was much too verbose and error-prone. I guess I was subconsciously porting an earlier C# version too literally, which had all these state variables as member variables. I tried implementing your suggestions myself, in order to learn from them. I changed my code in the question. Do you think I implemented your ideas well? \$\endgroup\$ Nov 14, 2012 at 15:42

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.