13 Concurrency 2: Getting comfortable with MVars

13.1 Overview

There is an exercise at the end of the file, you should do it.

../code/Concurrency2.hs

import Control.Concurrent
import Control.Monad (forever)
import Data.List (isPrefixOf)

import Debug.Trace (trace)
--------------------------------------------------------------------------------
-- Example 1: Phonebook --------------------------------------------------------
--------------------------------------------------------------------------------

-- Some type aliases for the data structures in question
type Name        = String
type PhoneNumber = String
type PhoneBook   = [(Name, PhoneNumber)]

-- Our global state is going to be a phonebook.
--
-- This is a bit counter-intuitive because all of the type aliases above are
-- pure values! So what gives?
--
-- Well, we can have a mutable _reference_ to an immutable phonebook. When we
-- want to 'change' the phonebook, we're really replacing it with a new one.

data PhoneBookState = PBS (MVar PhoneBook)
  
-- Creating a new PhoneBookState is just a matter of creating an empty `MVar`
new :: IO PhoneBookState
new = do
  mVarPB <- newMVar []
  return (PBS mVarPB)

-- Inserting into a PhoneBookState requires a bit more thought. We have to
-- do the following:
--
-- * `take` the `MVar`, which ensures that no other thread is manipulating the
--   global phonebook state at the same time we are
--
-- * create our new phonebook
--
-- * `put` the new phonebook in the `MVar`, ensuring that other threads can now
--   have access to the new phonebook
insert :: PhoneBookState -> PhoneBookState -> Name -> PhoneNumber -> IO ()
insert (PBS m) (PBS m2) n pn = do
  pb  <- takeMVar m
  pb2 <- takeMVar m2
  putMVar m ((n,pn):pb)

-- Looking up an entry in a phonebook _might_ fail, which means we're going
-- to return a `Maybe`
lookupPB :: Name -> PhoneBookState -> IO (Maybe PhoneNumber)
lookupPB n (PBS m) = do
  pb <- takeMVar m
  putMVar m pb
  return (lookup n pb)


-- Deleting an entry should update the PhoneBookState such that the given
-- name is removed from the Phonebook (`filter` might be useful here)
delete :: PhoneBookState -> Name -> IO ()
delete = error "TODO: You are meant to implement deleteEntry"

-- A new data type for commands from the user
data Command = Add String String  -- Name then PhoneNumber
             | Delete String
             | Lookup String
  deriving (Show, Eq)

-- The following are helper functions that will make writing `main` easier for
-- you. It's not necessary to understand their implementations in detail, but
-- you should understand the types and how to use them.
parseInput :: String -> Maybe Command
parseInput s
 | "add "    `isPrefixOf` s  = parseTwo Add    (drop 4 s)
 | "delete " `isPrefixOf` s  = parseOne Delete (drop 7 s)
 | "lookup " `isPrefixOf` s  = parseOne Lookup (drop 7 s)
 | otherwise                 = Nothing

parseTwo :: (String -> String -> Command) -> String -> Maybe Command
parseTwo c s = case words s of
                 [name, num] -> Just (c name num)
                 _           -> Nothing

parseOne :: (String -> Command) -> String -> Maybe Command
parseOne c s = case words s of
                 [name] -> Just (c name)
                 _      -> Nothing


-- Write a main function that does the following (the order of these steps
-- is not important this time!)
--
-- * Creates a new `PhoneBookState`
-- * gets user input, and creates a new thread that performs the appropriate
--   action
--
-- You may need to write helper functions to get all the behavior you want.
--
-- NOTE: ***********************************************************************
--       **   For the purposes of this example, we can assume that `forkIO`   **
--       ** threads terminate and clean up after they've finished their task  **
--       ** which means that you don't have to concern yourself with creating **
--       **                     'too many' threads                            **
--       ***********************************************************************
main = error "TODO: You are meant to implement `main`"

-- Example execution (important discussion below):
-- ghci> :main
-- > add cmsc 433
-- > add enes 430
-- > add math 140
-- > lookup hdcc
-- > Not found D:
-- lookup cmsc
-- 433
-- > delete cmsc
-- >^CInterrupted.

-- There is a subtle issue! Can you spot it? If you can get a similar execution
-- trace as above, then you can consider the exercise complete. That said, it
-- might be worth figuring out the issue and seeing if you can fix it!