# The Morra game implementation in Haskell

Me and my friends play a variant of Morra when drinking. The rules are as follows:

• The players sit in a circle and hold one of their hands in front of them.

• One player guesses a number. All the players (including this one) then hold out between 0 and 5 fingers on their hand.

• If there are as many fingers held out as the player guessed, he is "saved", leaves the circle and doesn't have to play anymore. Next turn another player tries to guess (otherwise the game just goes on with the player staying in the circle).

• The last player to remain in the circle has to drink.

I'm just learning about monad transformers, so I thought it would be nice to implement this simple game.

module Morra where

import Data.List
import Data.Char

main :: IO ()
main = do
putStrLn "Welcome to Morra. The last to remain has to drink."
putStr "Please input the names of players: "
psraw <- getLine
putStrLn ""
([p], n) <- execStateT (play 0) (words psraw, 0)
putStrLn $p ++ " has lost, after " ++ show n ++ " rounds. (S)he has to take a shot." play :: Int -> StateT ([String], Int) IO () play p = do (ps, n) <- get let currp = ps !! p if length ps == 1 then put (ps, n) else do liftIO$ putStr $"It's now " ++ currp ++ "'s turn. How many fingers will be help up? " a <- liftIO safeGetLine putNewLine liftIO$ putStrLn "[INPUT PHASE] Each player now chooses, how many fingers does (s)he hold up."
fs <- liftIO $getFingers (length ps) liftIO$ putStr "[END OF INPUT PHASE]"
putNewLine
if sum fs == a
then do
liftIO $putStrLn$ currp ++ " has guessed right, he's out."
putNewLine
let newps = delete currp ps
put (newps, n + 1)
play ((p + 1) mod length newps)
else do
liftIO $putStrLn$ currp ++ " hasn't guessed right, the game goes on!"
putNewLine
put (ps, n + 1)
play ((p + 1) mod length ps)
where
putNewLine = liftIO $putStrLn "" getFingers :: Int -> IO [Int] getFingers n = replicateM n helper where helper = do putStr "Input the number of fingers you hold up: " fs <- safeGetLine putStrLn "Pass the computer to the next player now. [ENTER]" getLine return fs safeGetLine :: IO Int safeGetLine = do x <- getLine if all isNumber x then return$ read x
else do
safeGetLine


Firstly, you can see the strings I print are pretty long, longer than the 80 chars limit. What is the common approach to tackle these and keep all the lines below 80 chars?

And secondly, please point out anything that could be made more elegant, whatever that might be (even changing the underlaying StateT). I'm also open to new ideas and challenges.

You don't really use the StateT to your advantage. Your play function can be written as

play :: Int -> ([String], Int) -> IO ([String], Int)
play p (ps, n) = do
let currp = ps !! p
if length ps == 1
then return (ps, n)
else do
putStr $"It's now " ++ currp ++ "'s turn. How many fingers will be help up? " a <- safeGetLine putNewLine putStrLn "[INPUT PHASE] Each player now chooses, how many fingers does (s)he hold up." fs <- getFingers (length ps) putStr "[END OF INPUT PHASE]" putNewLine if sum fs == a then do putStrLn$ currp ++ " has guessed right, he's out."
putNewLine
let newps = delete currp ps
play ((p + 1) mod length newps) (newps, n + 1)
else do
putStrLn $currp ++ " hasn't guessed right, the game goes on!" putNewLine play ((p + 1) mod length ps) (ps, n + 1) where putNewLine = putStrLn ""  That's not really surprising, since State s a is more or less just an abstraction of s -> (s, a). Since a is () in your case, we can just get rid of it and end up with s -> IO s. We can use State(T) to our advantage if we have several Stateful functions. However, we only have play. Speaking about play, there are several nitpicks: 1. You use length several times, although a single length call would suffice. 2. You should use guess instead of a as name. If we apply both, we end up with play :: Int -> StateT ([String], Int) IO () play p = do (ps, n) <- get let currp = ps !! p let plength = length ps unless (plength == 1)$ do
liftIO $putStr$ "It's now " ++ currp ++ "'s turn. How many fingers will be help up? "
guess <- liftIO safeGetLine
putNewLine
liftIO $putStrLn "[INPUT PHASE] Each player now chooses, how many fingers does (s)he hold up." fs <- liftIO$ getFingers plength
liftIO $putStr "[END OF INPUT PHASE]" putNewLine if sum fs == guess then do liftIO$ putStrLn $currp ++ " has guessed right, he's out." putNewLine put (delete currp ps, n + 1) play ((p + 1) mod (plength - 1)) else do liftIO$ putStrLn $currp ++ " hasn't guessed right, the game goes on!" putNewLine put (ps, n + 1) play ((p + 1) mod plength) where putNewLine = liftIO$ putStrLn ""


We didn't gain that much, did we? So let's split play:

type Player     = String
type Turn       = Int
type MorraT m a = StateT ([Player], Turn) m a
type Morra a    = MorraT IO a

play :: Morra ()
play = do
pcount <- getPlayerCount
unless (pcount == 1) $do currp <- getNextPlayer guess <- guessFingers currp fingers <- getFingers if fingers == guess then do putStrLn'$ currp ++ " has guessed right, they're out!"
removePlayer currp
else do
putStrLn' $currp ++ " hasn't guessed right, the game goes on!" increaseTurnCount play where putStrLn' xs = liftIO$ putStrLn xs >> putStrLn ""


That's easy enough to undestand. We also added some types so that we can change our program in a single line, for example if you want to change the StateT to something else later.

Now we need our helper functions:

players :: Monad m => MorraT m [Player]
players = fst <$> get  That's a convenient small function and makes it possible to change our Morra later without changing too many functions. For our getNextPlayer we want to get the next player as well as queue them to the back of the line. A list isn't the perfect data structure here, by the way, but we keep it for simplicity: getNextPlayer :: Monad m => MorraT m Player getNextPlayer = do (p:ps) <- players put (ps ++ [p]) return p  guessFingers looks exactly how you'd imagine it. It doesn't need to be in Morra, as it does not inspect the state, but let's keep it there for simplicity, again: guessFingers :: Player -> Morra Int guessFingers p = do liftIO$ putStrLn $p ++ ", what's your guess?" liftIO$ safeGetLine


Your variant of getFingers only tells a person to give the PC to the next player, but it does not tell them who the next player is going to be. That can be fixed by using forM instead of replicateM:

getFingers :: Morra Int
getFingers = do
ps <- players
fmap sum $forM ps$ \p ->
liftIO $putStrLn$ "How many fingers do you hold up, " ++ p ++ "?"
liftIO $getSafeLine  removePlayer looks the same as yours: removePlayer :: Monad m => Player -> MorraT m () removePlayer p = modify$ \(ps, n) -> (delete p ps, n)


Note that a setPlayers or withPlayers function would make both this and getNextPlayer simpler.

increaseTurnCount :: Monad m => MorraT m ()
increaseTurnCount = modify $\(ps, n) -> (ps, n + 1)  That's it. We now have several functions that can be used independently but act on the same state. By the way, the single increaseTurnCount hints that the amount of Turns isn't really part of the State, but could be used as the return value of play instead. For completeness, we can provide runMorra :: Monad m => [Player] -> MorraM m a -> m (Player, Int) runMorra ps = do ([p], n) <- execStateT play (ps, 0) return (p, n)  One last remark on safeGetLine. Instead of all isNumber use readMaybe from Text.Read: safeGetLine :: IO Int safeGetLine = do x <- getLine case readMaybe x of Just n -> return n Nothing -> putStrLn "Please input a number" >> safeGetLine  Otherwise your safeGetLine isn't safe, since isNumber also returns True on Unicode Characters in the 'Number, Other' Category. Your strings are no longer than 80 characters. Do you mean your lines of code? You don't need helper, you can pass the do block directly to replicateM n. The conceptual no-op put (ps, n) should be replaced with return (), but in this case unless captures it more precisely. The next-player arithmetic is wrong - if a player is removed, you skip over the original p+1 which is now p to the new p+1 which was originally p+2. Make sure to set stdin echoing to False, so people can't see what the others put in. Since getFingers is only used in one place, I'd inline it. main :: IO () main = do putStrLn "Welcome to Morra. The last to remain has to drink." putStr "Please input the names of players: " psraw <- getLine putStrLn "" ([p], n) <- withEcho False$ execStateT (play 0) (words psraw, 0)
putStrLn $p ++ " has lost, after " ++ show n ++ " rounds. (S)he has to take a shot." play :: Int -> StateT ([String], Int) IO () play p = do (ps, n) <- get let currp = ps !! p unless (length ps == 1)$ do
liftIO $putStr$ "It's now " ++ currp ++ "'s turn. How many fingers will be help up? "
a <- liftIO safeGetLine
putNewLine
liftIO $putStrLn "[INPUT PHASE] Each player now chooses, how many fingers does (s)he hold up." fs <- liftIO$ replicateM (length ps) $do putStr "Input the number of fingers you hold up: " fs <- safeGetLine putStrLn "Pass the computer to the next player now. [ENTER]" getLine return fs liftIO$ putStr "[END OF INPUT PHASE]"
putNewLine
if sum fs == a
then do
liftIO $putStrLn$ currp ++ " has guessed right, he's out."
putNewLine
let newps = delete currp ps
put (newps, n + 1)
play (p mod length newps)
else do
liftIO $putStrLn$ currp ++ " hasn't guessed right, the game goes on!"
putNewLine
put (ps, n + 1)
play ((p + 1) mod length ps)
where
putNewLine = liftIO $putStrLn "" safeGetLine :: IO Int safeGetLine = do x <- getLine if all isNumber x then return$ read x
else do
safeGetLine

withEcho :: Bool -> IO a -> IO a
withEcho echo action = do
old <- hGetEcho stdin
bracket_ (hSetEcho stdin echo) (hSetEcho stdin old) action


Getting the state at the start of your block, setting it at the end and recursing once makes StateT pretty superfluous, by the way.