# Removing OO style coding from Haskell

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

{-
Letter  : Letters of word
Term    : Word to guess (type name Term to avoid ambiguity)
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.

• 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?. – BCdotWEB Jul 8 at 6:15

# 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!

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

• Thank you, this is amazing! So much cleaner code to read! – userff Jul 9 at 13:11
• 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... – userff Jul 9 at 13:13
• 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. – cole Jul 9 at 16:52

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.