today's work, mainly on conc-mvar

Makefile

@@ -18,8 +18,11 @@ SAMPLES = \
   sudoku4 \
   sudoku5 \
   fork \
+  reminders \
+  reminders2 \
   mvar1 \
   mvar2 \
+  mvar3 \
   logger \
   geturls \
   geturlscancel \

logger.hs

@@ -3,38 +3,47 @@ import Control.Monad
 
 -- -----------------------------------------------------------------------------
 
--- <<logger
-data LogCommand = Message String | Stop (MVar ())
-
+-- <<Logger
 data Logger = Logger (MVar LogCommand)
 
+data LogCommand = Message String | Stop (MVar ())
+-- >>
+
+-- <<initLogger
 initLogger :: IO Logger
 initLogger = do
   m <- newEmptyMVar
   let l = Logger m
   forkIO (logger l)
   return l
+-- >>
 
+-- <<logger
 logger :: Logger -> IO ()
 logger (Logger m) = forever $ do
   cmd <- takeMVar m
   case cmd of
-    Message msg -> do 
-      threadDelay 10000
+    Message msg ->
       putStrLn msg
     Stop s -> do 
       putStrLn "logger: stop"
       putMVar s ()
+-- >>
 
+-- <<logMessage
 logMessage :: Logger -> String -> IO ()
 logMessage (Logger m) s = putMVar m (Message s)
+-- >>
 
+-- <<logStop
 logStop :: Logger -> IO ()
 logStop (Logger m) = do
   s <- newEmptyMVar
   putMVar m (Stop s)
   takeMVar s
+-- >>
 
+-- <<main
 main :: IO ()
 main = do
   l <- initLogger

mvar3.hs

@@ -0,0 +1,7 @@
+import Control.Concurrent
+
+-- <<main
+main = do
+  m <- newEmptyMVar
+  takeMVar m
+-- >>

reminders.hs

@@ -5,13 +5,13 @@ import Control.Monad
 
 main =
   forever $ do
-    l <- getLine                  -- <1>
-    forkIO $ setReminder (read l) -- <2>
+    s <- getLine           -- <1>
+    forkIO $ setReminder s -- <2>
 
-setReminder :: Int -> IO ()
-setReminder t = do
+setReminder :: String -> IO ()
+setReminder s  = do
+  let t = read s :: Int
   printf "Ok, I'll remind you in %d seconds\n" t
   threadDelay (10^6 * t)                   -- <3>
   printf "%d seconds is up! BING!\BEL\n" t -- <4>
 -- >>
-

reminders2.hs

@@ -0,0 +1,21 @@
+import Control.Concurrent
+import Text.Printf
+import Control.Monad
+
+-- <<main
+main = loop
+ where
+  loop = do
+    s <- getLine           -- <1>
+    if s == "exit"
+       then return ()
+       else do forkIO $ setReminder s -- <2>
+               loop
+-- >>
+
+setReminder :: String -> IO ()
+setReminder s  = do
+  let t = read s :: Int
+  printf "Ok, I'll remind you in %d seconds\n" t
+  threadDelay (10^6 * t)                   -- <3>
+  printf "%d seconds is up! BING!\BEL\n" t -- <4>