6
\$\begingroup\$

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.

\$\endgroup\$
3
\$\begingroup\$

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.

\$\endgroup\$
0
\$\begingroup\$

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.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.