HangPerson in Haskell

Question

I created a HangPerson game in Haskell and I must admit it feels very imperative. How can I make it more "functional?" Are there more elegant ways of breaking up the task? The getUserLines function seems to be doing a lot of work. Any additional feedback on efficiency or anything of the sort is also appreciated.

import Control.Monad.State
import System.Random
import Data.List
import System.Process
import Data.Char

type GameValue = String
type GameState = (Int, String)

playGame :: String -> String -> State GameState GameValue
playGame [] word = do
    (_, guessed) <- get
    return guessed

playGame (x:xs) word = do
    (missed, guessed) <- get
    put $ check missed x word guessed
    playGame xs word

check n c word guessed
    | not $ isAlpha c || c `elem` guessed = (n, guessed)
    | c `elem` word    = (n, c:guessed)
    | otherwise        = (n + 1, c:guessed)

replace word guess = map replace' word
    where replace' char = if char `elem` guess then char else '_'

gallows n = "\n\n       |||========|||\n" ++
            (if n > 0 then "       |||         |\n" else "       |||          \n") ++
            (if n > 1 then "       |||         O\n" else "       |||          \n") ++
            (if n < 2 then "       |||           \n" else (helper1 n)) ++
            (if n < 5 then "       |||           \n" else (helper2 n)) ++
            "       |||\n" ++ "       |||\n" ++ "     =================\n\n"

helper1 n
    | n <= 3    = "       |||        /  \n"
    | n <= 4    = "       |||        /| \n"
    | otherwise = "       |||        /|\\\n"

helper2 6 = "       |||        / \\\n"
helper2 _ = "       |||        /  \n"

safeHead []     = ' '
safeHead (x:xs) = x

menu = "\x1B[32m\t\t\t\tWelcome to Hangperson.\nThe rules are the same as always except\n\nIf you enter multiple characters only the first will be read.\nPress Ctrl+D to Give up.\nHave fun\x1B[0m"

getUserLines :: String -> IO String
getUserLines word = go (0, "") 
      where go contents = do
            system "clear"
            putStrLn menu
            let misses = fst contents
            let guessed = snd contents
            putStrLn $ gallows misses
            putStrLn $ "You've missed " ++ (show $ misses) ++ " out of 7"
            putStrLn $ "You've guessed: " ++ "\x1B[31m" ++ guessed ++ "\x1B[0m"
            putStrLn $ intersperse ' ' $ replace word guessed
            putStrLn "Guess a letter: "
            line <- getLine        
            let guess = [safeHead line]
            let result = execState (playGame guess word) contents
            if (((fst result) == 7) || '_' `notElem` (replace word ((snd result)))) 
            then (if (fst result) < 7 then return ("You won! The word was " ++ word) else return ("You lost! The word was " ++ word))
            else go result 

main = do
    system "reset"
    s <- readFile "/usr/share/dict/words"
    num <- randomIO :: IO Int
    let word = (lines s) !! (num `mod` 230000) --(length $ lines s)) efficient way?
    gameResult <- getUserLines (map toLower word)
    putStrLn gameResult
    putStrLn "Play again? :"
    option <- getLine
    if option == "y" then main else return ()

Answer 1

While your code might be working and written in a functional language, it also feels very procedural to me. Most idiomatic Haskell code I see has a very high signal to noise ratio. In your code I have to read every single line and figure out what it does in my head.

You can achieve this by making a lot of tiny functions (after all, composition is key for a functional program), and use as much of the domain language as possible. These tiny functions don't need to stand on their own; using let x=... in ... or where x= tends to help a lot.

Also, try to figure out what state you need to keep, and name it. I see a lot of functional programmers design their apps types-first. Having an explicit model that doesn't allow faulty state tends to help big-time.

Make sure you don't add state you can calculate from other state, use functions for that, otherwise your data structure might get inconsistent.

AFAIK tuples should mostly be used inside functions, but never exposed, except maybe for the most trivial cases like key-value pairs, and even that is debatable... After all, how much work is it to define data KeyValuePair a b= KeyValuePair a b

I am by no means an expert in Haskell, and learned these rules from doing mostly object-oriented programming. However, in a functional language these rules tend to be way easier to implement.

About operator shortcuts etc: I don't use them a lot - yet -, unless the Haskell linter suggests me to use it.

I do think that using a tool like ghc-mod and hlint is a necessity for Haskell development.

TL;DR: use proper types, extract parts into smaller functions, and try to properly name them.

import           Control.Monad (when)
import           Data.Char     (toLower)
import           Data.List     (transpose)
import           System.Random (randomIO)

wordsPath :: FilePath
wordsPath = "words.txt"-- "/usr/share/dict/words"

data GameState = GameState
    { _wordToGuess :: String
    , guesses     :: String
    }

data GameStatus = Guessing | GameWon | GameLost deriving Eq

hangmanImages :: [[String]]
hangmanImages =
    transpose
    [ [ "   ", " O ", " O ", " O ", " O " , "_O " , "_O_"  ]
    , [ "   ", "   ", " | ", " | ", " | " , " | " , " | "  ]
    , [ "   ", "   ", "   ", "/  ", "/ \\", "/ \\", "/ \\" ]
    ]

fullHangmanImage :: Int -> [String]
fullHangmanImage index =
    "=========" :
    "|    |" :
    map ("|   " ++) img
    where img = hangmanImages !! index


maxWrongGuesses :: Int
maxWrongGuesses = length hangmanImages - 1

numberOfWrongGuesses :: GameState -> Int
numberOfWrongGuesses (GameState word' guesses') =
    length $ filter charNotInWord guesses'
    where charNotInWord c = c `notElem` word'

gameStatus :: GameState -> GameStatus
gameStatus (GameState word' guesses')
    | isGuessed     = GameWon
    | isLastGuess'  = GameLost
    | otherwise     = Guessing
    where
        isGuessed = all isCharInGuesses word'
        isCharInGuesses x = x `elem` guesses'
        gameState = GameState word' guesses'
        isLastGuess' = numberOfWrongGuesses gameState == maxWrongGuesses

-- for one reason or another getChar also appends <CR>
-- so I implemented my own getChar and made sure empty input is refused
getAChar :: IO Char
getAChar = do
    line <- getLine
    case line of
        [] -> getAChar
        (c:_) -> return c

getANewChar :: GameState -> IO Char
getANewChar gameState = do
    putStrLn "Next char to guess"
    c <- getAChar
    if c `elem` guesses gameState
    then do
        putStrLn "Character already used in guesses."
        getANewChar gameState
    else
        return c

displayState :: GameState -> IO ()
displayState (GameState word' guesses')  =
    putStrLn $ unlines $ case gameStatus gameState of
        Guessing -> fullHangmanImage' ++
            [ "Word to guess: " ++ wordWithGuesses
            , ""
            , "Guesses: " ++ guesses'
            ]
        GameWon -> fullHangmanImage' ++
            [ "CONGRATULATIONS!"
            , "You correctly guessed the word " ++ word'
            , " in " ++ show (length guesses') ++ " tries "
            ]
        GameLost -> fullHangmanImage' ++
            [ "YOU FAILED!"
            , "You failed to guess the word " ++ word'
            ]
    where
        gameState = GameState word' guesses'
        fullHangmanImage' = fullHangmanImage currentHangmanIndex
        currentHangmanIndex = numberOfWrongGuesses gameState
        wordWithGuesses = blankOrChar <$> word'
        blankOrChar c
            | c `elem` guesses' = c
            | otherwise = '_'

gameLoop :: GameState -> IO ()
gameLoop gameState = do
    displayState gameState
    when (gameStatus gameState == Guessing) $ do
        c <- getANewChar gameState
        gameLoop $ gameState { guesses = guesses gameState ++ [c] }

newGame :: IO GameState
newGame = do
    contents <- readFile wordsPath
    let words' = filter validWord $ lines contents
    let wordcount = length words'
    randomNumber <- randomIO
    let randomWord = words' !! (randomNumber `mod` wordcount)
    return $ GameState randomWord []
    where
        validWord word =
            '\'' `notElem` word &&
            map toLower word == word

main :: IO ()
main = do
    newGame >>= gameLoop
    putStrLn "Play again? (y/n):"
    option <- getAChar
    when (option == 'y') main