import Control.Concurrent
import Control.Concurrent.STM
import Data.IORef

-- concurrency -- ukazka

test1 m = do threadDelay 3000000
	     putStrLn "b"
	     putMVar m ()
test2 m = do threadDelay 1000000
	     putStrLn "a"
	     putMVar m ()
test3 m = do threadDelay 5000000
	     putStrLn "c"
	     putMVar m ()

w1 = do
      m1 <-newEmptyMVar
      m2 <-newEmptyMVar
      m3 <-newEmptyMVar
      forkIO (test1 m1)
      forkIO (test2 m2)
      forkIO (test3 m3)
      takeMVar m1
      takeMVar m2
      takeMVar m3

-- problem -- synchronizace:

inc::IORef Int->QSemN->IO ()
inc x s =
  do
    v <- readIORef x
    writeIORef x (v + 1)
    signalQSemN s 1

doInc::Int -> IORef Int -> IO ()
doInc n r =
  do
    s <- newQSemN 0
    sequence_ (replicate n $ forkIO (inc r s))
    waitQSemN s n

w2 = do
       r <- newIORef 0
       doInc 100000 r
       x <- readIORef r
       putStrLn (show x)

-- reseni -- zamky -- slozite, nutne zamezit deadlocku, ...
-- jinak: transakce; pokud zapis neprobehne atomicky, cela transakce se odroluje a zopakuje
--   nelze realizovat primo v monade IO (vedlejsi efekty typu "launchMisiles" nejde odrolovat)

-- The STM monad
-- data STM a
-- instance Monad STM

-- Exceptions
-- throw :: Exception -> STM a
---catch :: STM a -> (Exception->STM a) -> STM a

-- Running STM computations
-- atomically :: STM a -> IO a
-- retry :: STM a
-- orElse :: STM a -> STM a -> STM a

-- Transactional variables
-- data TVar a
-- newTVar :: a -> STM (TVar a)
-- readTVar :: TVar a -> STM a
-- writeTVar :: TVar a -> a -> STM ()

incS::TVar Int->QSemN->IO ()
incS x s =
  do
    atomically $
      do
        v <- readTVar x
        writeTVar x (v + 1)
    signalQSemN s 1

doIncS::Int -> TVar Int -> IO ()
doIncS n r =
  do
    s <- newQSemN 0
    sequence_ (replicate n $ forkIO (incS r s))
    waitQSemN s n

w3 = do
       r <- atomically (newTVar 0)
       doIncS 100000 r
       x <- atomically (readTVar r)
       putStrLn (show x)

-- cekani na udalost

produce::TVar [Int]->Int->IO ()
produce q n =
  do
    atomically $
      do
        s <- readTVar q
        writeTVar q (n : s)

consume::TVar Int->TVar [Int]->IO ()
consume e q =
  do
    s <- atomically $
      do
        l <- readTVar q
        if length l < 100
           then retry
           else do
                  writeTVar q (drop 100 l)
                  return (take 100 l)
    putStrLn (show $ sum s)
    atomically $
      do
       k <- readTVar e
       writeTVar e (k-1)

w4 =
  do
    s <- atomically (newTVar [])
    e <- atomically (newTVar 10)
    sequence_ (replicate 10 $ (forkIO $ consume e s))
    mapM_ (\n -> forkIO (produce s n)) [1..1000]
    atomically $
      do
        ne <- readTVar e
        if ne /= 0 then retry else return ()