Internals.hs

{-# LANGUAGE PatternGuards, BangPatterns #-}
module BuildBox.Command.System.Internals
	( streamIn
	, streamOuts)
where
import System.IO
import Control.Concurrent
import Data.ByteString.Char8		(ByteString)
import qualified Data.ByteString.Char8	as BS	


-- | Continually read lines from a handle and write them to this channel.
--   When the handle hits EOF then write `Nothing` to the channel.
streamIn  :: Handle -> Chan (Maybe ByteString) -> IO ()
streamIn !hRead !chan
 = do	eof	<- hIsEOF hRead
	if eof
	 then do
		writeChan chan Nothing
		return ()
		
	 else do
		str	<- BS.hGetLine hRead
		writeChan chan (Just str)
		streamIn hRead chan


-- | Continually read lines from some channels and write them to handles.
--   When all the channels return `Nothing` then we're done.
--   When we're done, signal this fact on the semaphore.
streamOuts :: [(Chan (Maybe ByteString), (Maybe Handle), QSem)] -> IO ()
streamOuts !chans 
 = streamOuts' False [] chans

	-- There doesn't seem to be a way to perform a unix-style "select" on channels.
	-- We want to wait until any of the channels becomes available for reading.
	-- We're doing this just by polling them each in turn, and waiting a bit
	--	if none of them had any data.
		
 where	-- we're done.
	streamOuts' _ []   []	
		= return ()

	-- play it again, sam.
	streamOuts' True prev []	
	 = 	streamOuts' False [] prev

	streamOuts' False prev []
	 = do	threadDelay 100000
		streamOuts' False [] prev

	-- try to read from the current chan.
	streamOuts' !active !prev (!x@(!chan, !mHandle, !qsem) : rest)
	 = isEmptyChan chan >>= \empty -> 
	   if empty 
	    then streamOuts' active (prev ++ [x]) rest
	    else do
		mStr	<- readChan chan
		case mStr of
		 Nothing	
		  -> do	signalQSem qsem
			streamOuts' active prev rest

		 Just str 
		  | Just h	<- mHandle
		  -> do	BS.hPutStr h str
			hPutChar   h '\n'
			streamOuts' True (prev ++ [x]) rest

		  | otherwise
		  -> 	streamOuts' True (prev ++ [x]) rest