Prelude
First of all, good work! I can see the effort you put into grokking something so foreign, and I would like to commend you for it. I will be focusing on reviewing what I think you can improve, but don't let these critiques discourage you—all code can be improved, but not all code works.
I'll be doing a combination of making general comments and addressing blocks of code, in order from top to bottom. In each section the code will generally not be runnable, since I'll be putting side-by-side comparisons of your code and my code. I'll include the full revision at the end.
I'm not the foremost expert on all things Haskell, so take my comments however you wish. I hope they help!
Comments
I recommend using haddock syntax to markup your comments. In my revised code, I use this syntax.
Use of StateT
Since this is an exercise, I think it's fine to use StateT so you can learn how to work with monad stacks. But since the Hangman datatype is so simple, you could also just pass it throughout your functions. If I were making hangman, I would probably do this since why bother with the complexity of having a monad stack when it's just as convenient to write regular functions?
One way you can refactor is to observe that State a s is essentially equivalent to s -> (a, s), so you could, say, pass around tuples instead. You could also make your guess function be of type Hangman -> Hangman so that it modifies the game state and then you could decide in gameLoop what status to return. In this case, you wouldn't even need to pass around tuples.
Type aliases
When you have a monad stack (in your case, StateT Hangman IO), it's common to see people make a type alias for it like type HangmanM a = StateT Hangman IO a. I think you need to explicitly take the type variable as an argument, but you may be able to avoid it.
You only use this stack once, so you don't really need to make an alias – I did because I end up using it twice due to a revision.
Smart constructors
Later in your code you make a sample Hangman value manually. You might eventually want to make arbitrary Strings and Ints into these values, so it's conventional to make a smart constructor like so
mkHangman :: String -> Int -> Hangman
mkHangman word lives = Hangman (map Hidden word) lives Set.empty
You'll see that I define sampleMan as mkHangman "apple" 7.
playGame
I think it makes more sense to have game-ending logic in playGame, so I pattern match on the output of runStateT gameLoop hangman and print based on it.
-- Yours
playGame :: Hangman -> IO (Status, Hangman)
playGame = runStateT gameLoop
-- Mine
playGame :: Hangman -> IO ()
playGame hangman = do
(status, _hangman') <- runStateT gameLoop hangman
case status of
-- You could print the number of guesses remaining here, if so desired.
Victory -> putStrLn "Victory!"
-- You could print what the word was here, if so desired.
Defeat -> putStrLn "Defeat!"
_ -> error $
"Expected status to be Victory or Defeat, got " ++ show status ++ "."
gameLoop
I don't really think that the general structure of this code is that bad. There's basically one place where you falter.
You don't use your monad stack.
The State Hangman Status returned by guess and the StateT IO Hangman Status returned by gameLoop are different stacks. You essentially pull the state out of the game loop and then reconstruct it for guess. You'll see that I change the type of state to be StateT IO Hangman Status. That way, I can just do val <- guess newGuess in order to get the result.
Likewise, I don't have to worry about putting things back in the state. I let guess modify the state and then I pull the new state out to print it if guess returns Playing.
You'll notice that this code isn't really that different aside from some reordering.
-- Yours
gameLoop :: StateT Hangman IO Status
gameLoop = do
newGuess <- liftIO IO.getChar
liftIO $ putStrLn $ "Your guess: " ++ [newGuess]
hangman <- get
let (val, newHangman) = runState (guess newGuess) hangman
case val of
Repeat -> do
put hangman
liftIO $ putStrLn "You already tried that.\n"
gameLoop
Victory -> liftIO $ putStrLn "\nVictory!" >> return Victory
Defeat -> liftIO $ putStrLn "\nDefeat!" >> return Defeat
Playing -> do
put newHangman
liftIO $ putStrLn $ show newHangman ++ "\n"
gameLoop
-- Mine
gameLoop :: HangmanM Status
gameLoop = do
newGuess <- liftIO IO.getChar
liftIO $ putStrLn $ "Your guess: " ++ [newGuess]
val <- guess newGuess
case val of
Repeat -> do
liftIO $ putStrLn "You already tried that.\n"
gameLoop
Playing -> do
newHangman <- get
liftIO $ putStrLn (show newHangman ++ "\n")
gameLoop
Victory -> return Victory
Defeat -> return Defeat
guess
I pretty much refactored gameLoop by offloading some extra work to guess. This function is very different. One thing I used to help simplify it was the language pragma MultiWayIf to construct multiple branches of an if statement at the same depth. It makes the code look a lot cleaner without so many if then elses.
Since guess and gameLoop share the same monad stack, I can just get the current state and use put to modify it. I only use put if the state is being changed, which saves some work.
I also left some things for you to add if you wanted to—your code doesn't handle upper/lower case and erroneous characters (e.g. '1' or '¢').
-- Yours
guess :: Char -> State Hangman Status
guess guessChar = do
h@(Hangman word lives guessedChars) <- get
if guessChar `elem` guessedChars
then do -- If char was already guessed, prompt user to repeat
put h
return Repeat
else do
let decrementedLives = lives - 1
newGuessedChars = Set.insert guessChar guessedChars
if Hidden guessChar `elem` word -- If guess is correct
then do
let updatedWordStatus = updateWord word guessChar
put (Hangman updatedWordStatus decrementedLives newGuessedChars)
return $ hasWon updatedWordStatus -- If won, return Victory
else
if decrementedLives == 0
then return Defeat
else do -- Keep playing!
put (Hangman word decrementedLives newGuessedChars)
return Playing
-- Mine
guess :: Char -> HangmanM Status
guess guessChar = do
Hangman word lives guessedChars <- get
let newLives = lives - 1
if
-- TODO: deal with invalid character guesses
| False ->
undefined
| newLives <= 0 ->
return Defeat
| guessChar `elem` guessedChars ->
return Repeat
| otherwise -> do
let updatedWord = updateWord word guessChar
put $ Hangman updatedWord newLives (Set.insert guessChar guessedChars)
return $ hasWon updatedWord
where
-- TODO: deal with letter case
normalizedGuess = undefined
updateWord and hasWon
I didn't really change these. I used a guard to simplify your helper for updateWord and renamed a few things. You can see the changes in the full code.
Full code
Feel free to ask about anything that I didn't comment on, whether it be my revised code or your initial code. Full disclaimer: I made pretty big changes and didn't write tests, so our versions may differ!
{-# LANGUAGE MultiWayIf #-}
{- A simple gameLoop of hangman.-}
module Hangman where
import qualified Data.Set as Set
import qualified System.IO as IO
import qualified System.Random as Rand
import Control.Monad.State
import Control.Monad.IO.Class(liftIO)
-- | Letters comprising a hangman word.
data Letter
= Hidden Char
| Revealed Char
deriving (Eq)
-- | A hangman word in a game.
type Term = [Letter]
-- | Guessed characters in a game.
type Guessed = Set.Set Char
-- | A Hangman game.
data Hangman = Hangman { word :: Term -- ^ Guessed word so far.
, lives :: Int -- ^ Number of lives.
, guessedChars :: Guessed -- ^ Guessed characters.
}
-- Helper type alias for the Hangman monad stack.
type HangmanM a = StateT Hangman IO a
-- | Smart constructor to make a hangman game with a fully hidden word and a
-- certain number of lives.
mkHangman :: String -> Int -> Hangman
mkHangman word lives = Hangman (map Hidden word) lives Set.empty
-- | Hangman game status.
data Status
= Playing -- ^ Game in progress.
| Defeat
| Victory
| Repeat -- ^ Repeat a turn.
deriving (Show)
letterToChar :: Letter -> Char
letterToChar (Hidden _) = '_'
letterToChar (Revealed char) = char
instance Show Hangman where
show (Hangman word lives guessedChars) =
unwords [ shownWord
, " Lives: "
, show lives
, "\nGuesses so far: "
, shownGuessedChars
]
where
shownWord = map letterToChar word
shownGuessedChars = Set.elems guessedChars
main = do
IO.hSetEcho IO.stdin False
IO.hSetBuffering IO.stdin IO.NoBuffering
playGame sampleMan
playGame :: Hangman -> IO ()
playGame hangman = do
(status, _hangman') <- runStateT gameLoop hangman
case status of
-- You could print the number of guesses remaining here, if so desired.
Victory -> putStrLn "Victory!"
-- You could print what the word was here, if so desired.
Defeat -> putStrLn "Defeat!"
_ -> error $
"Expected status to be Victory or Defeat, got " ++ show status ++ "."
-- | Gets character from stdin, guesses it,
-- and then performs action based on the guess result.
-- Loops back to the begin if game hasn't ended.
gameLoop :: HangmanM Status
gameLoop = do
newGuess <- liftIO IO.getChar
liftIO $ putStrLn $ "Your guess: " ++ [newGuess]
val <- guess newGuess
case val of
Repeat -> do
liftIO $ putStrLn "You already tried that.\n"
gameLoop
Playing -> do
newHangman <- get
liftIO $ putStrLn (show newHangman ++ "\n")
gameLoop
Victory -> return Victory
Defeat -> return Defeat
-- | Function that returns the hangman state and game state after a guess.
guess :: Char -> HangmanM Status
guess guessChar = do
Hangman word lives guessedChars <- get
let newLives = lives - 1
if
-- TODO: deal with invalid character guesses
| False ->
undefined
| newLives <= 0 ->
return Defeat
| guessChar `elem` guessedChars ->
return Repeat
| otherwise -> do
let updatedWord = updateWord word guessChar
put $ Hangman updatedWord newLives (Set.insert guessChar guessedChars)
return $ hasWon updatedWord
where
-- TODO: deal with letter case
normalizedGuess = undefined
-- | When we get a correct guess, update hidden char to revealed.
-- Otherwise, do nothing.
updateWord :: Term -> Char -> Term
updateWord word guessChar = map helper word
where
helper (Hidden hiddenChar)
| hiddenChar == guessChar = Revealed guessChar
helper val = val
-- | If all letters are revealed, game is won.
hasWon :: Term -> Status
hasWon word = if all isRevealed word then Victory else Playing
where
isRevealed (Hidden _) = False
isRevealed (Revealed _) = True
-- | Sample hangman word
sampleMan = mkHangman "apple" 7
```
