caf-0.0.2: Examples/Examples.hs

{- |
Module      :  <File name or $Header$ to be replaced automatically>
Description :  This module provides examples on concurrency abstractions with futures.
Maintainer  :  mwillig@gmx.de
Stability   :  experimental
Portability :  non-portable (requires Futures)

This module provides examples for concurrency abstractions using futures.
For each abstractions there is one example using 'do' and one
with 'Futures.withFuturesDo'. In the case without 'Futures.withFuturesDo' the 
main thread terminates after a while. If we use 'Futures.withFuturesDo' as recommended,
the main thread never stops before its child-threads.
-}

module Control.Concurrent.Futures.Examples (
    bufferExampleF,
    bufferExample,
    channelExampleF,
    channelExample,
    bchannelExampleF,
    bchannelExample,
    qsemExampleF,
    qsemExample,
    hqsemExampleF,
    hqsemExample,
    barExampleF,
    barExample
--    tsExample
 ) where

import qualified Control.Concurrent.Futures.Futures as Futures
import qualified Control.Concurrent.Futures.Buffer as Buffer
import qualified Control.Concurrent.Futures.Chan as Chan
import qualified Control.Concurrent.Futures.BChan as BChan
import qualified Control.Concurrent.Futures.QSem as QSem
import qualified Control.Concurrent.Futures.Barrier as Barrier
import qualified Control.Concurrent.Futures.HQSem as HQSem
import Control.Concurrent

import Data.List

-- local finals
oneSecond = 1000000

-- | Producer Consumer example with buffers demonstrating 'Futures.withFuturesDo'.
bufferExampleF:: IO ()
bufferExampleF = Futures.withFuturesDo bufferExample

-- | Producer Consumer example with buffers.
bufferExample :: IO ()
bufferExample = do
 putStrLn $ "Producer-Consumer example with buffers"
 b <- Buffer.newBuf
 Control.Concurrent.forkIO $ (writeBufferThread b)
 Control.Concurrent.forkIO $ (readBufferThread b)
 Control.Concurrent.threadDelay $ 10 * oneSecond

writeBufferThread b = do
 Buffer.putBuf b 1
 Buffer.putBuf b 2
 Buffer.putBuf b 3

readBufferThread b = do 
 val <- Buffer.getBuf b
 putStrLn $ "read: " ++ show val
 Control.Concurrent.threadDelay oneSecond
 readBufferThread b

--------------------------------------------------------------------------------
-- | Producer Consumer Example for channels using 'Futures.withFuturesDo'.
channelExampleF :: IO ()
channelExampleF = Futures.withFuturesDo channelExample

-- | Producer Consumer Example for channels.
channelExample :: IO ()
channelExample = do
 putStrLn $ "Producer-Consumer example with channels"
 channel <- Chan.newChan
 Control.Concurrent.forkIO $ (produce 10 channel)
 Control.Concurrent.forkIO $ (consume channel)
 Control.Concurrent.threadDelay $ 10 * oneSecond

consume :: (Show a) => Chan.Chan a -> IO b
consume chan = do
 putStrLn $ "Trying to read..."
 val <- Chan.readChan chan
 putStrLn $ "read new value: " ++ show val
 Control.Concurrent.threadDelay oneSecond
 consume chan

produce :: (Num a) => a -> Chan.Chan a -> IO ()
produce n chan = do
 case n of
  0 -> Chan.writeChan chan n
  otherwise -> do
   Chan.writeChan chan n
   Control.Concurrent.threadDelay oneSecond
   produce (n-1) chan
 
   --------------------------------------------------------------------------------
-- | Scenario for quantity semaphores using 'Futures.withFuturesDo'.
qsemExampleF :: IO ()
qsemExampleF = Futures.withFuturesDo qsemExample

-- | Scenario for for quantity semaphores with buffers.
qsemExample :: IO ()
qsemExample = do
 putStrLn $ "Scenario example with quantity semaphores"
 qsem <- QSem.newQSem 1
 Control.Concurrent.forkIO $ (useQSem qsem)
 Control.Concurrent.forkIO $ (useQSem qsem)
 Control.Concurrent.threadDelay $ 10 * oneSecond

useQSem ::QSem.QSem -> IO ()
useQSem q = do
 QSem.down q
 i <- Control.Concurrent.myThreadId
 putStrLn $ show i ++ " entered."
 Control.Concurrent.threadDelay $ 2 * oneSecond
 QSem.up q
 
    --------------------------------------------------------------------------------
-- | Scenario for handled quantity semaphores using 'Futures.withFuturesDo'.
hqsemExampleF :: IO ()
hqsemExampleF = Futures.withFuturesDo hqsemExample

-- | Scenario for handled quantity semaphores.
hqsemExample :: IO ()
hqsemExample = do
 putStrLn $ "Scenario with quantity semaphores with handles"
 qsem <- HQSem.newHQSem 1
 Control.Concurrent.forkIO $ (useHQSem qsem)
 Control.Concurrent.forkIO $ (useHQSem qsem)
 Control.Concurrent.threadDelay $ 10 * oneSecond

useHQSem :: HQSem.HQSem -> IO ()
useHQSem q = do
 HQSem.downHQSem q
 i <- Control.Concurrent.myThreadId
 putStrLn $ show i ++ " entered."
 Control.Concurrent.threadDelay $ 2 * oneSecond
 HQSem.upHQSem q


 
    --------------------------------------------------------------------------------
-- | Example for barrier using 'Futures.withFuturesDo'.
barExampleF :: IO ()
barExampleF = Futures.withFuturesDo barExample

-- | Example for barrier: 4 threads syncinc on the barrier.
barExample :: IO ()
barExample = do
 putStrLn $ "4 Threads syncing on a barrier. This demo takes a bit time."
 bar <- Barrier.newBar 4
 Control.Concurrent.forkIO $ (doSomething 7 bar)
 Control.Concurrent.forkIO $ (doSomething 12 bar)
 Control.Concurrent.forkIO $ (doSomething 2 bar)
 Control.Concurrent.forkIO $ (doSomething 20 bar)
 Control.Concurrent.threadDelay $ 10 * oneSecond

--doSomething :: Int -> Barrier.Bar a -> IO ()
doSomething time bar = do
 Control.Concurrent.threadDelay $ time * oneSecond
 i <- Control.Concurrent.myThreadId
 putStrLn $ show i ++ " syncing."
 Barrier.syncBar bar
 return ()

 
  --------------------------------------------------------------------------------
-- | Producer Consumer Example for bounded channels using 'Futures.withFuturesDo'.
bchannelExampleF :: IO ()
bchannelExampleF = return () --Futures.withFuturesDo bchannelExample

-- | Producer Consumer Example for bounded channels.
bchannelExample :: IO ()
bchannelExample = do
 putStrLn $ "Producer-Consumer example with channels"
 channel <- BChan.newBChan 5
 Control.Concurrent.forkIO $ (produceb 10 channel)
 Control.Concurrent.forkIO $ (consumeb channel)
 Control.Concurrent.threadDelay $ 10 * oneSecond

--consumeb :: (Show a) => BChan.BChan a -> IO b
consumeb chan = do
 putStrLn $ "Trying to read..."
 val <- BChan.readBChan chan
 putStrLn $ "read new value: " ++ show val
 Control.Concurrent.threadDelay oneSecond
 consumeb chan
 return ()

--produceb :: (Num a) => a -> BChan.BChan a  -> IO ()
produceb n chan = do
 case n of
  0 -> BChan.writeBChan chan n
  otherwise -> do
   BChan.writeBChan chan n
   Control.Concurrent.threadDelay oneSecond
   produceb (n-1) chan