select-0.4: example/SelectExample2.hs

module Main where

import System.IO
import System.Posix.IO
import System.Posix.IO.Select.FdSet.Unsafe
import System.Posix.IO.Select
import System.Posix.IO.Select.Types
import System.Posix.Types
import Control.Concurrent
import Control.Concurrent.STM.OrElseIO
import Control.Concurrent.STM
import Control.Concurrent.STM.TMVar
import Control.Concurrent.STM.TChan

flags :: OpenFileFlags
flags = OpenFileFlags { append = False, exclusive = False, noctty = False, nonBlock = True, trunc = False }

main :: IO ()
main =
    handleToFd stdin >>= \stdinfd  ->
    newEmptyTMVarIO >>= \t ->
    forkIO (interruptor t) >>
    putStrLn "The interruptor has been launched." >>
    newTChanIO >>= \c ->
    forkIO (interruptor2 c) >>
    putStrLn "The TChan interruptor has been launched." >>
    openFd "fifo" ReadOnly Nothing flags >>= \fd -> 
    openFd "fifo2" ReadOnly Nothing flags >>= \fd2 -> 
    openFd "fifo3" ReadOnly Nothing flags >>= \fd3 -> 
    openFd "fifo4" ReadOnly Nothing flags >>= \fd4 -> 
    let
        readfds = [fd, fd2, fd3, stdinfd, fd4]
        writefds = []
        exceptfds = []
    in
    putStrLn "The file was opened, so let the waiting game begin!" >>
    runOrElse (select (fromList readfds) empty empty (finite 9 0)) (readTChan c) >>= \ret ->
        case ret of
          Left x -> (
                     case x of
                       Error -> putStrLn ("Select error.")
                       Timeout -> putStrLn ("Select timed out.")
                       Ready n _ _ _ -> putStrLn ("There are " ++ show n ++ " readies.")
                    ) >>
                    putStrLn ("Ready read: " ++ (show (inList readfds (readyRead x)))) >>
                    putStrLn ("Ready write: " ++ (show (inList writefds (readyWrite x)))) >>
                    putStrLn ("Ready except: " ++ (show (inList exceptfds (readyException x))))
          Right s -> putStrLn ("Oh no, the interruptor is here: " ++ s  )

interruptor :: TMVar String -> IO ()
interruptor t = threadDelay (10 * 1000000) >>
                atomically (putTMVar t "Bwahahaha, the interruptor was first!")

interruptor2 :: TChan String -> IO ()
interruptor2 c = threadDelay (15 * 1000000) >>
                 atomically (writeTChan c "Bwhaha, TChan interruptor was first!")