12 Concurrency 1: Getting Started with MVars

12.1 Overview

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

../code/Concurrency1.hs

import Control.Monad
import Control.Concurrent


--------------------------------------------------------------------------------
-- Example 1 -------------------------------------------------------------------
--------------------------------------------------------------------------------

-- | replicateM_ is defined in Control.Monad. Our use has the type:
-- replicateM_ :: Monad m => Int -> m a -> m ()

-- | forkIO is defined in Control.Concurrent. It is similar to `fork` from
-- CMSC216 except we don't have to worry about figuring out which thread is the
-- parent and which is the child, with `forkIO` we are always the parent and
-- the child thread gets spawned off. We get the ThreadID of the child (in the
-- example below we are not using the ThreadID of the child
example1 = do
  forkIO (replicateM_ 1000000 (putChar 'a'))
  replicateM_ 1000000 (putChar 'B')

--------------------------------------------------------------------------------
-- Example 2 -------------------------------------------------------------------
--------------------------------------------------------------------------------

-- In this example we are implementing user-specified timers. We do this by
-- splitting the logic into two parts:
--
-- * the user interface
-- * the timer itself
--
-- All our user interface has to do is wait for input from the user. Whenever
-- it gets input it spawns of a thread to do the timer for the specific input.
--
-- `setReminder` is the logic for an individual timer

reminderMain = do
  forever $ do
    s <- getLine
    forkIO (setReminder s)

setReminder :: String -> IO ()
setReminder s = do
  let t = read s :: Int -- This is naughty, we should do proper parsing
  putStrLn ("Will remind you in " ++ s ++ " seconds")
  threadDelay (10^6 * t)
  putStrLn "You're reminded"
  
--------------------------------------------------------------------------------
-- Example 3 -------------------------------------------------------------------
--------------------------------------------------------------------------------

-- Both of the previous examples had a flaw that we want to avoid as much as
-- possible when implementing concurrent programs: All threads had unrestricted
-- access to the same resource!
--
-- In the examples above the resource in question was stdin+stdout. The better
-- practice is to _control_ access to shared resources so that the seperate
-- threads do not 'step on each other'.
--
-- In Haskell the basic building block for controlling concurrent access to
-- resources is the `MVar`.
--
-- An `MVar a` can be viewed as a container container containing a value of
-- type `a`, but the implementation of `MVar` ensures that only one entity
-- has access to that value at any given time.
--
-- The basic API for `MVar`s is as follows:
--
-- newEmptyMVar ::                IO (MVar a)
-- newMVar      ::           a -> IO (MVar a)
-- putMVar      :: MVar a -> a -> IO ()
-- takeMVar     :: MVar a      -> IO a
--
-- All of these functions operate in `IO`, which means that are not pure functions.
-- An `MVar` can either be empty or contain a value. What makes them useful for
-- concurrent programming is the _behavior_ of `putMVar` and `takeMVar`.
--
-- If you call `putMVar` on an `MVar` that already has a value, the current thread
-- (the one calling `putMVar`) will _block_ until the `MVar` is empty.
--
-- If you call `takeMVar` on an `MVar` that is empty, the current thread (the one
-- calling `takeMVar`) will _block_ until the `MVar` contains a value.
--
-- This allows `MVars` to control access to a resource.
--
-- A thread can call `takeMVar`, get access to the `MVar`'s value, and until some
-- thread calls `putMVar` all calls to `takeMVar` will block.
--
-- Below we use this behavior to sequence two actions: 
--
-- * we create an empty `MVar`, which means all calls to `takeMVar` will block
-- until the `MVar` is filled
--
-- * we fork a thread that has a delay, at the end of the delay it calls `putMVar`,
--   filling the `MVar` with the specified value
--
-- * Back in the parent thread, we call `takeMVar` which will block until the
--   `MVar` is filled. Once the `MVar` is filled (by the other thread calling
--   `putMVar`), the thread will unblock, get the value from the `MVar` and
--   continue executing.

ex3 = do
  m <- newEmptyMVar
  forkIO (threadDelay (10^6 * 7) >> putMVar m 'x')
  r <- takeMVar m
  putStrLn "After takeMVar"
  putChar r


--------------------------------------------------------------------------------
-- Example 4: TODO -------------------------------------------------------------
--------------------------------------------------------------------------------

threadA :: MVar String -> IO ()
threadA m = do
  str <- takeMVar m
  putStrLn ("ThreadA saw " ++ str)

threadB :: MVar String -> IO ()
threadB m = do
  str <- takeMVar m
  putStrLn ("B-thread saw " ++ str)

-- given the two functions above, write a `main` function that performs the
-- following:
--
-- * creates an `MVar`
-- * spawns two new threads, one for each of the above functions. These threads
--   should loop forever and both threads should have access to the same `MVar`
-- * Does the following forever:
--   - gets input from the user (can be anything as long as it's a `String`)
--   - puts that user input in the `MVar`
--
--

main = do
  m <- newEmptyMVar
  forkIO (forever (threadA m))
  forkIO (forever (threadB m))
  forever $ do
    str <- getLine
    putMVar m str