Textbased User Interface for user and program taking turns

Question

I wrote this program to model interactions between a user and an artificial player, both playing by the same rules (not enforced here for simplicity).
The game played is here is "your next word has to start with the last letter of mine"

module Main where

import Lib
import System.Random
import System.Exit
import Control.Monad

vocab     = ["alpha","beta","gamma"]
blacklist = []

pick:: [a] -> IO a --picks random element. copy pasted, not understood
pick x = Control.Monad.liftM (x !!) (randomRIO (0, length x - 1))

main :: IO ()
main = do
  userInput <- getLine
  processUser userInput vocab blacklist

processUser :: String -> [String] -> [String] -> IO a
processUser input vocab blacklist = if input == "quit" then exitSuccess
                                    else do
                                          successor <- getNext input vocab (input:blacklist)
                                          processPC successor vocab blacklist

processPC :: Maybe (IO String) -> [String] -> [String] -> IO a
processPC  Nothing      v b = do putStrLn "I give up" 
                                 exitSuccess

processPC (Just ioWord) v b = do word <- ioWord
                                 putStrLn word
                                 userInput <- getLine
                                 processUser userInput v (word:b)

getNext:: String -> [String] -> [String] -> IO (Maybe (IO String))
getNext lastWord vocab blacklist  = do let chooseFrom = filter (`notElem` blacklist) vocab
                                       let matches    = filter (\x -> head x == last lastWord) chooseFrom
                                       if null matches then return Nothing
                                       else return (Just (pick matches) )

I am especially interested how to formulate this better structurally-

Answer 1

The main issue with this code is that basically everything “lives” in IO. One of the advantages of Haskell over other programming languages is the ability to cleanly separate effects, and you should strive to implement as much of your code as possible in a pure context, then only actually use IO at the top level of your program.

Breaking apart getNext

The most egregious example of this is getNext, which has a pretty convoluted return value, IO (Maybe (IO String)). This is IO nested inside another IO type, which is pretty convoluted. Ideally, that function shouldn’t need to be anything but completely pure, anyway, so it should really return something like Maybe String.

Taking a step back for a moment, though, what does getNext even do? The name getNext is pretty vague. More than that, though, it has a lot of responsibilities. Let’s list them:

1. It accepts the last word the player typed in, then finds what letter it ended with.
2. It filters blacklisted words out of a larger wordlist.
3. It finds the words that start with the letter found in step 1.
4. Finally, it picks a random word from that list.

This is a lot of different responsibilities for just one function! Haskell works especially well when you define small, atomic functions that only do one thing at a time, then compose them together. Distilling the core functionality, this function should really probably just find all the words in a list that start with a particular character, then return all of them. You can implement this in a single line using isPrefixOf from Data.List:

import Data.List (isPrefixOf)

startingWith :: Char -> [String] -> [String]
startingWith c = filter (isPrefixOf [c])

(As an aside, this actually fixes a problem with your original code, which used head. The head function is partial; that is, it will crash if given an empty list. The isPrefixOf function will handle empty lists properly.)

IO and strong typing

Now, what about handling the other responsibilities? Well, picking a random element is probably the trickiest thing to do because it is sort of side-effectful. You could manually thread a random number generator state around, but that would be a bit cumbersome. One good way to handle this is the MonadRandom typeclass from the package of the same name, which allows writing a pickRandom function without IO:

import Control.Monad.Random (MonadRandom(..))

pickRandom :: MonadRandom m => [a] -> m (Maybe a)
pickRandom [] = return Nothing
pickRandom xs = Just . (xs !!) <$> getRandomR (0, length xs - 1)

This has two improvements over the pick function you found:

1. It properly handles the case of empty lists by returning Maybe a. The version of pick you found would simply crash.
2. It does not depend on IO, just on MonadRandom, which is significantly less powerful.

Haskell has lots of ways to be very precise about the type of things. Rather than making everything nullable, it has Maybe. Rather than just passing strings around, Haskell favors using ADTs. Haskell also provides a way from distinguishing between pure and impure operations using the IO type, but in many ways, IO provides some very weak guarantees.

When a function returns IO, it can effectively do anything. It can spawn threads, it can interact with the filesystem, and it can even send data over the network. Ideally, it would be nicer to have more fine-grained typing, just like we have with Haskell’s domain-specific, fine-grained ADTs.

To accomplish this, it’s often possible to use typeclasses like MonadRandom, which encode a very specific set of capabilities. Functions that include a MonadRandom constraint can do one thing: generate random numbers. Now, because MonadRandom is a typeclass, not a datatype, it does not specify how those numbers are generated; it is up to the caller to decide that. The MonadRandom typeclass actually has an instance for IO, which allows generating numbers using the system random number generator, but it also has an instance for the Rand type, which is a purely functional random number generation monad.

We haven’t decided how we’re going to generate random numbers yet. We might even use IO, eventually. However, that’s not the point… the main point is that we’ve now written a function that can do nothing more than its type claims it can, and that’s a good thing.

Handling turns

Now that we have some extremely basic primitives, we can put them together to create handlers for user and computer turns. Each turn can result in one of two actions: giving up, or submitting a word. Therefore, let’s encode that into a datatype, then implement some extremely simple functions for each kind of turn:

data Turn = Word String | GiveUp

userTurn :: String -> Turn
userTurn "quit" = GiveUp
userTurn input  = Word input

computerTurn :: MonadRandom m => String -> [String] -> m Turn
computerTurn lastWord wordList = maybeToTurn <$> maybeRandomWord
  where lastChar = last lastWord
        maybeRandomWord = pickRandom (startingWith lastChar wordList)
        maybeToTurn = maybe GiveUp Word

The computerTurn function is a little more complex, but it’s not too bad. It uses the maybe function, which is a convenient helper for transforming a Maybe value into a value of another type (in this case, Turn), and it uses <$>, which is just an infix alias for fmap.

One nice thing about these implementations is, again, we are able to learn a lot about these functions just by looking at their types. The userTurn function is extremely pure, and the computerTurn function uses randomness, but nothing else.

Writing the main loop

Now that we have some primitives, we can write a top-level interpreter that will actually drive the game itself. This function will be a bit longer, since it will handle the actual imperative logic of the game, but it will also be extremely simple, since it’s basically just wiring things together.

One thing that we have pretty much eliminated is the concept of a word blacklist. After all, why not just remove words from the word list itself rather than maintaining two separate lists and threading them around everywhere? We can completely eliminate the need for a blacklist by just pulling words out of the computer’s vocabulary.

import Data.List (delete)

runGame :: [String] -> IO [String]
runGame wordList = do
  userInput <- getLine
  case userTurn userInput of
    GiveUp -> exitSuccess
    Word userWord -> do
      let remainingWords = delete userWord wordList
      computerResult <- computerTurn userWord remainingWords
      case computerResult of
        GiveUp -> putStrLn "I give up" >> exitSuccess
        Word computerWord -> do
          putStrLn computerWord
          runGame (delete computerWord remainingWords)

This function may look a little complicated, but it’s really not so bad—by just following the types, the function effectively writes itself. We call userTurn, then handle both potential Turn cases. Next, we call computerResult and handle both of its possible cases. Once that’s done, we just loop, and we’re done! The result of runGame is just the number of words left in the computer’s vocabulary.

Now, all that’s left to do is invoke runGame from main:

main :: IO ()
main = void $ runGame vocab

The void function just ignores the result of runGame vocab, properly returning IO (), and it kicks off the main loop by passing in the initial vocab list.

The final result

Here’s the final code after all of my changes:

module Main where

import Data.List (delete, isPrefixOf)
import Control.Monad (void)
import Control.Monad.Random (MonadRandom(..))
import System.Exit (exitSuccess)

data Turn = Word String | GiveUp

vocab :: [String]
vocab = ["alpha","beta","gamma"]

main :: IO ()
main = void $ runGame vocab

runGame :: [String] -> IO [String]
runGame wordList = do
  userInput <- getLine
  case userTurn userInput of
    GiveUp -> exitSuccess
    Word userWord -> do
      let remainingWords = delete userWord wordList
      computerResult <- computerTurn userWord remainingWords
      case computerResult of
        GiveUp -> putStrLn "I give up" >> exitSuccess
        Word computerWord -> do
          putStrLn computerWord
          runGame (delete computerWord remainingWords)

userTurn :: String -> Turn
userTurn "quit" = GiveUp
userTurn input  = Word input

computerTurn :: MonadRandom m => String -> [String] -> m Turn
computerTurn lastWord wordList = maybeToTurn <$> maybeRandomWord
  where lastChar = last lastWord
        maybeRandomWord = pickRandom (startingWith lastChar wordList)
        maybeToTurn = maybe GiveUp Word

pickRandom :: MonadRandom m => [a] -> m (Maybe a)
pickRandom [] = return Nothing
pickRandom xs = Just . (xs !!) <$> getRandomR (0, length xs - 1)

startingWith :: Char -> [String] -> [String]
startingWith c = filter (isPrefixOf [c])

Formatting changes aside, the main differences from your original code are strengthening the types and separating concerns as much as possible to isolate effects. I have also removed do from most of the function implementations, since do tends to force code into a pseudo-imperative style that eliminates a lot of the declarative benefits of Haskell.

Some of the things in this answer might be a bit more advanced than you’ve been exposed to yet, and that’s okay! In truth, there are probably even fancier ways to accomplish what you want—a free monad came to mind when writing this answer, for example. However, the point of this is not to be either so far above you that you can’t understand it, nor to be precisely at your level. It’s alright if not all of this makes sense to you just yet, but I hope that by reaching for some more complicated concepts, you’ll be encouraged, not discouraged, to challenge yourself some more.

Answer 2

The very first thing that jumps out at me is the indirection of maintaining both a list of possible words and a seen list. Picking a better representation for your state will make bookkeeping easier.

type Word = String
type Words = [Word]
type Moves = Map.Map Char Words

Now fill in the logically necessary functions needed to work with that state. We need to be able to construct a state blob—

makeMoves :: Words -> Moves
makeMoves = Map.fromListWith (++) . catMaybes . map tag
  where
    tag :: Word -> Maybe (Char, Words)
    tag []      = Nothing
    tag w@(c:_) = Just (c, [w])

Remove played words from one—

remove :: Word -> Moves -> Moves
remove []      = id
remove w@(c:_) = Map.adjust (delete w) c

And choose a new word from one given the constraint imposed by the last play.

move :: Char -> Moves -> IO (Maybe (Word, Moves))
move c ms =
  let possible = Map.lookup c ms
  in  case possible of
        Nothing -> return Nothing
        Just [] -> return Nothing
        Just ws -> do
          w <- pick ws
          return $ Just (w, remove w ms)

Note the separation from any logic in taking turns, or which player is currently up. Testing these operations will be much easier then (load them up in GHCi and try it out), and integrating them into our monadic game playing code should be pretty straightforward, just follow the types.

processUser :: Moves -> IO ()
processUser moves = do
    input <- getLine
    case input of
      "quit" -> return ()
      ""     -> do putStrLn "You must enter a word."
                   processUser moves
      w      -> processPC (last w) (remove w moves)

Note also how I have moved the logic for making a player move into the function where it makes sense to do so. User player code shouldn't drive computer player code, and vice versa. As an exercise, try making the necessary modifications and stylistic tweaks to processPC yourself.

You should make a best effort attempt at understanding all of the functions you write into your source. Copy and pasting pick in when you don't understand it is poor form, where'd you even find that definition? At least use a library. If you don't know what liftM is doing, just write the function out using do-notation as you would any other operation in the IO monad.

pick :: [a] -> IO a
pick xs = do
    i <- randomRIO (0, length xs - 1)
    return (xs !! i)

---

Spoilers—Here are the commit-level changes and final runnable code I produced while working through this.

Answer 3

pick is uniform from Control.Monad.Random.

Stuff that you only ever plan to use once and in one place should usually be inlined.

StateT allows us to abstract away the passing around of the blacklist.

forever replaces this recursion.

Your null matches into an if is subject to Boolean Blindness and should instead be done via a uniformMay combinator. It's a shame it doesn't exist. Let's make a pull request to MonadRandom and pretend it does.

LambdaCase reduces naming further.

{-# LANGUAGE LambdaCase #-}

module Main where

import Lib
import System.Random
import System.Exit
import Control.Monad
import Control.Monad.Random
import Control.Applicative
import Control.Monad.State

vocab     = ["alpha","beta","gamma"]
blacklist = []

main :: IO ()
main = (`evalStateT` blacklist) $ forever $ do
  input <- liftIO getLine
  when (input == "quit") $ liftIO exitSuccess
  modify (input:)
  matches <- gets $ filter (\x -> head x == last input) . (vocab \\)
  uniformMay matches >>= \case
    Nothing -> do
      liftIO $ putStrLn "I give up"
      liftIO exitSuccess
    Just word -> do
      liftIO $ putStrLn word
      modify (word:)

We can go one step further and use MaybeT to less use the maybe-considered-harmful exitSuccess:

module Main where

import System.Random
import System.Exit
import Control.Monad
import Control.Monad.Random
import Control.Applicative
import Data.List
import Control.Monad.State
import Control.Monad.Trans.Maybe

vocab     = ["alpha","beta","gamma"]
blacklist = []

main :: IO ()
main = do
  runMaybeT $ (`evalStateT` blacklist) $ forever $ do
    input <- liftIO getLine
    when (input == "quit") $ liftIO exitSuccess
    modify (input:)
    matches <- gets $ filter (\x -> head x == last input) . (vocab \\)
    word <- lift $ MaybeT $ uniformMay matches
    liftIO $ putStrLn word
    modify (word:)
  liftIO $ putStrLn "I give up"