HaskellでスレッドのMVar

ここを参考にして。
Haskellでマルチスレッド処理 - Qiita

こうやるとこんなエラーが出る。

import Control.Concurrent
main = do
  x <- newMVar "set01"
  takeMVar x >>= \y -> putStrLn y
  takeMVar x >>= \y -> putStrLn y

Main> main
set01
*** Exception: thread blocked indefinitely in an MVar operation

う〜んなんでだろう。
いろいろ試行錯誤してみよう。

・・・・・・
http://chimera.labs.oreilly.com/books/1230000000929/ch07.html#sec_mvars
The takeMVar operation removes the value from a full MVar and returns it, but waits (or blocks) if the MVar is currently empty.
takeMVar操作はフルMVarから値を削除し、それを返しますが、MVarが現在空の場合待機する（またはブロック）。
そうなのかー。

それでこんなプログラムを作った。
文字列を1つずつ削りながら表示するのだが、
'd'を入力すると１つずつデバッグ表示する。

module Keyin where

import Control.Concurrent

data St = Run | Debug | Wait deriving (Eq)

outgo :: MVar St -> String -> IO ()
outgo st [] = putStr ""
outgo st (x:xs) = do
  print xs
  threadDelay (1*1000*1000)
  st2 <- takeMVar st
  putMVar st st2
  if st2 == Run then outgo st xs
  else do
    takeMVar st >>= \_-> putMVar st Wait
    waitloop st xs
  where
    waitloop :: MVar St -> String -> IO ()
    waitloop st xs = do
      st2 <- takeMVar st
      putMVar st st2
      if st2 == Wait then waitloop st xs
      else outgo st xs


main :: IO ()
main = do
  st <- newMVar Run
  ou <- forkIO $ outgo st "asdfghjklqwertyuiop"
  keyloop st ou

  where
    keyloop :: MVar St -> ThreadId -> IO ()
    keyloop st ou = do
      k <- getChar
      case k of
        'r' -> takeMVar st >>= \_-> putMVar st Run
        'd' -> takeMVar st >>= \_-> putMVar st Debug
        _   -> return ()
      if k == 'q' then killThread ou
      else keyloop st ou

Keyin> main
"sdfghjklqwertyuiop"
"dfghjklqwertyuiop"
"fghjklqwertyuiop"
"ghjklqwertyuiop"
"hjklqwertyuiop"
"jklqwertyuiop"
"klqwertyuiop"
g"lqwertyuiop"

"qwertyuiop"
"wertyuiop"
"ertyuiop"
d"rtyuiop"

d
"tyuiop"
d
"yuiop"
d
"uiop"
d
"iop"
r
"op"
"p"
""
q
*Keyin>

MVarはカラの時にtakeMVarすると止まるし、
フルの時にputMVarすると止まるみたいだ。