1
\$\begingroup\$

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   |", " /|\\  |", " / \\  |", "      |", "========="]
\$\endgroup\$

1 Answer 1

2
\$\begingroup\$

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\
               \========="
              ]

\$\endgroup\$
1
  • \$\begingroup\$ 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! \$\endgroup\$ Jun 28 at 12:39

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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