Hangman game in Haskell, written using a state monad

Question

I recently made a simple hangman game in Haskell but soon wanted to explore the state monad, since it could possibly simplify the code. The result was this (see below), which is exactly 30% more lines than not using the monad. My question is therefore: am I using the feature correctly?

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# HLINT ignore "Eta reduce" #-}
{-# HLINT ignore "Use fmap" #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
import Control.Monad (replicateM_, (>>))
import Control.Monad.State
import Data.Functor
import Data.List (elemIndices, sort)
import System.IO (BufferMode (NoBuffering), hFlush, hSetBuffering, stdin)
pictures :: Int
pictures = 9
data Phase = Continue | Win | Loss
instance Show Phase where
 show Loss = "You lost!"
 show Win = "You won!"
 show _ = "Keep going!"
data GameVars = GameVars
 { word :: String,
 rights :: [Char],
 wrongs :: [Char],
 lives :: Int
 }
instance Show GameVars where
 show g@GameVars {word, rights, wrongs, lives} = unlines [renderHangman g, renderLives g, renderWrongs g, renderWord g]
type GameState a = StateT GameVars IO a
main :: IO ()
main = do
 w <- getWord
 clearScreen
 void $ execStateT hang (GameVars {word = w, rights = [], wrongs = [], lives = pictures})
hang :: GameState ()
hang = do
 st <- get
 lift $ print st
 next >>= \case
 Win -> announce Win
 Loss -> announce Loss
 Continue -> again
isLoss :: GameState Bool
isLoss = gets ((== 0) . lives)
announce :: Phase -> GameState ()
announce p = do
 s <- get
 let hangman = renderHangman s
 lift clearScreen
 lift $ putStrLn hangman
 lift $ print p
 lift $ putStrLn ("The correct word was " ++ word s ++ "\n")
again :: GameState ()
again = do
 guess <- lift getGuess
 isCorrect <- correctGuess guess
 lift clearScreen
 st <- get
 let st'
 | guess `elem` (rights st ++ wrongs st) = st
 | isCorrect = st {rights = guess : rights st}
 | otherwise = st {wrongs = guess : wrongs st, lives = lives st - 1}
 put st'
 hang
next :: GameState Phase
next = do
 w <- isWin
 l <- isLoss
 let n
 | w = Win
 | l = Loss
 | otherwise = Continue
 return n
isWin :: GameState Bool
isWin = get >>= \s -> return $ all (`elem` rights s) (word s)
win :: GameState ()
win = do
 s <- get
 put $ s {rights = word s}
clearScreen :: IO ()
clearScreen = replicateM_ 40 (putStrLn "")
correctGuess :: Char -> GameState Bool
correctGuess guess = get <&> ((guess `elem`) . word)
getGuess :: IO Char
getGuess = putStrLn "Guess a letter!" >> getChar
getWord :: IO String
getWord = clearScreen >> putStrLn "Give a secret word!" >> getLine
renderWord :: GameVars -> String
renderWord GameVars {word, rights} = map (\c -> if c `elem` rights then c else '_') word
renderWrongs :: GameVars -> String
renderWrongs GameVars {wrongs = []} = ""
renderWrongs GameVars {wrongs} = "Wrong guesses: " ++ sort wrongs
renderHangman :: GameVars -> String
renderHangman GameVars {lives} = unlines . hangmanpics $ lives
renderLives :: GameVars -> String
renderLives GameVars {lives} = show lives ++ " guesses left!"
hangmanpics :: Int -> [String]
hangmanpics 9 = [" ", " ", " ", " ", " ", " ", "========="]
hangmanpics 8 = [" ", " |", " |", " |", " |", " |", "========="]
hangmanpics 7 = [" +---+", " |", " |", " |", " |", " |", "========="]
hangmanpics 6 = [" +---+", " | |", " |", " |", " |", " |", "========="]
hangmanpics 5 = [" +---+", " | |", " O |", " |", " |", " |", "========="]
hangmanpics 4 = [" +---+", " | |", " O |", " | |", " |", " |", "========="]
hangmanpics 3 = [" +---+", " | |", " O |", " /| |", " |", " |", "========="]
hangmanpics 2 = [" +---+", " | |", " O |", " /|\\ |", " |", " |", "========="]
hangmanpics 1 = [" +---+", " | |", " O |", " /|\\ |", " / |", " |", "========="]
hangmanpics 0 = [" +---+", " | |", " O |", " /|\\ |", " / \\ |", " |", "========="]
hangmanpics _ = [" +---+", " | |", " O |", " /|\\ |", " / \\ |", " |", "========="]

Answer 1

The below is pretty casual, sorry it's not better organized or cited.

• You're not using the bound attribute values in instance Show GameVars.
• Instead of void $ execStateT ..., just use evalStateT.
• Your implementation of clearScreen is not really good UX design, but building good shell UX is outside the scope of a hangman game :)
• Using >>= explicitly is often less readable than just using do. In hang it makes sense; in isWin a do would be better.
• An instance of GameVars is the state of a game; that's ok. But an instance of GameState _ is not the state of a game; it's not even primarily a functor of such; it's a description of arbitrary behavior in the IO monad involving game state. I suggest renaming these.
• You've broken out a lot of little functions into the top level namespace. This feels like clutter. If a thing fit's inline, put it inline until there's a reason to move it (it gets big enough or you want to share it across locations). The first place to move it is usually a where clause, so it's still clear what it's for when someone finds it. As an example, if we inline isWin and isLoss, the whole logic of next becomes clearer. (You don't have to like the way I got rid on n.) (yes, you will sometimes want to put something in the top namespace just to help you debug it, that's fine.)
• you can often avoid using lift so much by leveraging the MonadIO class.
• single-character variable names are ok when they are in some sense "fully general", it's kinda a haskell idiom to use them for stuff that's arbitrary vis a vis the function. When there's a reasonable word-sized name for a variable, use it.
• With the current logic, you could leave lives out of the record, and just have lives gs = length (rights gs) + length (wrongs gs), but it'd make the whole thing more fragile than it needs to be.
• win is unused.
• Using a Show instance to UI stuff is a normal mistake people make; Show is better reserved for debugging purposes, where the resulting string looks basically like the code that created the instance. For UI purposes it's better to have a dedicated function.
• Finding a good abstraction and learning to use it is hard. I'm not super fond of monad transformers, but they're an appropriate choice for the task at hand. In this context, prefer gets over get and modify over put.
• hangmanpics is going to be ugly no matter what you do, don't fight it.
• Is the user supposed to have 9 lives, or 10? I may have an off-by-one mistake in my version.

I need to go do actual work now, so let me know if anything in this version doesn't make sense. We should not assume it's "better".

{-# LANGUAGE NamedFieldPuns #-}
{-# HLINT ignore "Eta reduce" #-}
{-# HLINT ignore "Use fmap" #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
module CR277633
( main
, hang
) where
import Control.Monad (replicateM_, (>>))
import Control.Monad.State
import Data.Functor
import Data.Function (on)
import Data.List (nub, sort)
import Data.Maybe (fromMaybe)
import System.IO (BufferMode (NoBuffering), hFlush, hSetBuffering, stdin)
data Phase = Continue | Win | Loss
data GameState = GameState
 { word :: String,
 rights :: [Char],
 wrongs :: [Char],
 lives :: Int
 }
type Gameplay a = StateT GameState IO a
printString :: (MonadIO m) => String -> m ()
printString = liftIO . putStrLn
main :: IO ()
main = do
 clearScreen
 printString "Give a secret word!"
 secretWord <- liftIO getLine
 clearScreen
 evalStateT hang (GameState {word = secretWord,
 rights = [],
 wrongs = [],
 lives = length hangmanpics})
hang :: Gameplay ()
hang = do
 gamestate <- get
 printString $ render gamestate
 result <- next
 handleNext result
 where render GameState{word, rights, wrongs, lives} = unlines [ renderHangman lives
 , show lives ++ " guesses left!"
 , case wrongs of
 [] -> ""
 _ -> "Wrong guesses: " ++ sort wrongs
 , mask rights <$> word
 ]
 mask known secret = if secret `elem` known then secret else '_'
 next :: Gameplay Phase
 next = do
 gamestate <- get
 let won = all (`elem` rights gamestate) (word gamestate)
 lost = 0 == lives gamestate
 return $ case () of
 _ | won -> Win
 _ | lost -> Loss
 _ -> Continue
 handleNext :: Phase -> Gameplay ()
 handleNext Continue = do
 printString "Guess a letter!"
 guess <- liftIO getChar
 clearScreen
 rights' <- gets $ nub . (guess :) . rights
 wrongs' <- gets $ nub . (guess :) . wrongs
 lives' <- gets $ newLives guess
 modify (\s -> s {rights = rights', wrongs = wrongs', lives = lives'})
 hang
 handleNext winLose = do
 gamestate <- get
 clearScreen
 (printString . renderHangman) =<< gets lives
 printString $ announcementFor winLose
 (printString . ("The correct word was " ++)) =<< gets word
 printString ""
 announcementFor Loss = "You lost!"
 announcementFor Win = "You won!"
 announcementFor Continue = "Keep going!" -- unused
 newLives guess GameState{word, rights, wrongs, lives}
 | guess `elem` rights = lives
 | guess `elem` wrongs = lives
 | guess `elem` word = lives
 | otherwise = lives - 1
clearScreen :: (MonadIO m) => m ()
clearScreen = replicateM_ 40 (printString "")
renderHangman :: Int -> String
renderHangman lives = if len <= lives then last pics else pics !! lives
 where len = length hangmanpics
 pics = reverse hangmanpics
hangmanpics :: [String]
hangmanpics = [" \n\
 \ \n\
 \ \n\
 \ \n\
 \ \n\
 \ \n\
 \========="
 ," \n\
 \ | \n\
 \ | \n\
 \ | \n\
 \ | \n\
 \ | \n\
 \========="
 ," +---+ \n\
 \ | \n\
 \ | \n\
 \ | \n\
 \ | \n\
 \ | \n\
 \========="
 ," +---+ \n\
 \ | | \n\
 \ | \n\
 \ | \n\
 \ | \n\
 \ | \n\
 \========="
 ," +---+ \n\
 \ | | \n\
 \ O | \n\
 \ | \n\
 \ | \n\
 \ | \n\
 \========="
 ," +---+ \n\
 \ | | \n\
 \ O | \n\
 \ | | \n\
 \ | \n\
 \ | \n\
 \========="
 ," +---+ \n\
 \ | | \n\
 \ O | \n\
 \ /| | \n\
 \ | \n\
 \ | \n\
 \========="
 ," +---+ \n\
 \ | | \n\
 \ O | \n\
 \ /|\\ | \n\
 \ | \n\
 \ | \n\
 \========="
 ," +---+ \n\
 \ | | \n\
 \ O | \n\
 \ /|\\ | \n\
 \ / | \n\
 \ | \n\
 \========="
 ," +---+ \n\
 \ | | \n\
 \ O | \n\
 \ /|\\ | \n\
 \ / \\ | \n\
 \ | \n\
 \========="
 ]

• ola_bandola: These were some really hands-on great tips for writing idiomatic Haskell code. Many, many thanks! Especially about creating Show instances, that caught me off guard but makes total sense. I was also conceptually wrong about "GameState", thanks for catching that, too. I'll make sure to go over each bullet thoroughly!