Removing OO style coding from Haskell

Question

Having coded in Objected-Oriented style my entire programming career, it's hard to adapt to functional style fully.

I implemented a simple Hangman game:

{- 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)
{-
Letter : Letters of word
Term : Word to guess (type name Term to avoid ambiguity)
Guessed : Already guessed characters
Status : Status of game
-}
data Letter = Hidden Char | Revealed Char deriving (Eq)
type Term = [Letter]
type Guessed = Set.Set Char
data Hangman = Hangman {word :: Term, 
 lives :: Int, 
 guessedChars :: Guessed} 
data Status = Playing | Defeat | Victory | Repeat deriving (Show)
charShowLetter :: Letter -> Char
charShowLetter (Hidden _) = '_'
charShowLetter (Revealed char) = char
instance Show Hangman where
 show (Hangman word lives guessedChars) =
 showTerm word ++ " Lives: " ++ show lives ++ 
 "\nGuesses so far: " ++ showGuessed guessedChars
 where showGuessed = Set.elems 
 showTerm = map charShowLetter
main = do
 IO.hSetEcho IO.stdin False
 IO.hSetBuffering IO.stdin IO.NoBuffering
 playGame sampleMan
playGame :: Hangman -> IO (Status, Hangman)
playGame = runStateT gameLoop
gameLoop :: StateT Hangman IO 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.
Seems basically like procedural programming...
-}
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
guess :: Char -> State Hangman Status
{-
Obnoxious function that returns 
the hangman state and game state after a guess.
Args : Char
 guessed character
Returns: State Hangman Status
 runState will return (Status, Hangman.)
-}
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
updateWord :: Term -> Char -> Term
-- When we get a correct guess, update hidden char to revealed.
updateWord word newChar = map helper word
 where helper hidden@(Hidden hiddenChar) = 
 if hiddenChar == newChar then Revealed newChar else hidden
 helper val = val
hasWon :: Term -> Status
-- If all letters are revealed, game is won.
hasWon word = if all helper word then Victory else Playing
 where helper (Hidden _) = False
 helper (Revealed _) = True
-- Hardcoded samples to test code.
sampleWord = [Hidden 'a', Hidden 'p', 
 Hidden 'p', Hidden 'l', Hidden 'e']
sampleMan = Hangman sampleWord 7 (Set.fromList [])

However, I feel like this code isn't really that functional programming, because...

1. The Hangman ADT serves a rough implementation of a class.
2. The main functions, gameLoop and guess, are basically more or less the same code in procedural programming.
3. All the functions are basically class methods for the Hangman ADT, just not instantiated as such.

After all, as the famous saying goes, you can write FORTRAN in any language.

Any critiques, suggestions, improvements are highly welcome.

Thank you in advance!

• BCdotWEB: The current question title of your question is too generic to be helpful. Please edit to the site standard, which is for the title to simply state the task accomplished by the code. Please see How do I ask a good question?.

Answer 1

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
```

• gust: Thank you, this is amazing! So much cleaner code to read!
• gust: That being said, in the gameLoop function, you just use newHangman <- get -- is it getting the state from val <- guess newGuess even though nothing is explicitly put? I couldn't figure this out by looking at simply the docs...
• cole: Yes, it is getting the state that was modified by guess newGuess. The docs probably aren’t going to help much here if you’re confused. One way to see that it works is to mentally inline the code in guess. But what I recommend doing is writing out the monad instance for newtype State a s = s -> (a,s). It’s not too bad if you follow the types. It might help to learn/remember how currying works in Haskell and that a -> (b -> c) = a -> b -> c. Once you know how >>= and return are implemented, you can desugar the do notation and see why it works.

Answer 2

The code looks fine. At a high level, I don't think it really makes sense to say that this code follows a particularly object-oriented or functional style, maybe because the application is too simple. The difference in this case is really more a matter of perspective.

From an OOP point of view, maybe you see a type with a bunch of methods. That's okay. (It's not too exciting when it doesn't involve more advanced ideas like subtyping and dynamic dispatch.)

Well, FP looks at different things, even though you end up with the same code. The concrete language is what really guides the implementation, however you choose to approach it.

• Data representation using algebraic data types and pattern-matching, so you can tell upfront the shape of the data, and so that all cases are handled in one place for each function. In this example the difference with OO is hard to tell because the main type, Hangman is not a tagged union. Tagged unions as they're found in FP would typically be translated to multiple classes in OOP, with the implementation of each method split among them. I'm not saying either way is always better, they're just different approaches with their trade-offs (see also, "the expression problem").

• Pure functions, explicit effects: small auxiliary functions are pure, so you can tell without looking at their code that they're not going to surprise you with any side effect; similarly, more complex functions still have explicit types which delimit their abilities, you can't modify the wrong state unless it's already somewhere in the function's type.

• Higher-order functions: there are no loop constructs like while or for baked into the language, instead there is explicit recursion which is often hidden behind functions to iterate or transform a computation following some common patterns (map, all).

As you can see, these are features that you naturally have to contend with when writing Haskell. There isn't really a dichotomy between FP and OOP, rather, those terms encompass a bunch of ideas that may manifest themselves in any particular application, but they're not mutually exclusive, and the choice of language can make them more or less relevant.