The Morra game implementation in Haskell

Question

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 Control.Monad.Trans.State
import Control.Monad.Trans
import Control.Monad
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
 putStrLn "Please input a number"
 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.

Answer 1

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.

Answer 2

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
 putStrLn "Please input a number"
 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.