FiniteChan.hs

module Control.Concurrent.FiniteChan (
	Chan,
	newChan, openedChan, closedChan, doneChan, sendChan, getChan, closeChan, stopChan
	) where

import Control.Monad (void, when, liftM2)
import Control.Monad.Loops
import Control.Concurrent.STM

-- | 'Chan' is stoppable channel
data Chan a = Chan {
	chanOpened :: TMVar Bool,
	chanQueue :: TQueue a }

-- -- | Create new channel
newChan :: IO (Chan a)
newChan = liftM2 Chan (newTMVarIO True) newTQueueIO

-- | Is channel opened
openedChan :: Chan a -> IO Bool
openedChan = atomically . readTMVar . chanOpened

-- | Is channel closed
closedChan :: Chan a -> IO Bool
closedChan = fmap not . openedChan

-- | Is channel closed and all data consumed
doneChan :: Chan a -> IO Bool
doneChan ch = atomically $ do
	o <- readTMVar $ chanOpened ch
	e <- isEmptyTQueue (chanQueue ch)
	return $ not o && e

-- | Write data to channel if it is open
sendChan :: Chan a -> a -> IO Bool
sendChan ch v = atomically $ do
	o <- readTMVar $ chanOpened ch
	when o $ writeTQueue (chanQueue ch) v
	return o

-- | Get data from channel
getChan :: Chan a -> IO (Maybe a)
getChan ch = atomically $ do
	o <- readTMVar $ chanOpened ch
	if o
		then fmap Just (readTQueue (chanQueue ch))
		else tryReadTQueue (chanQueue ch)

-- | Close channel
closeChan :: Chan a -> IO ()
closeChan ch = atomically $ void $ swapTMVar (chanOpened ch) False

-- | Close channel and read all messages
stopChan :: Chan a -> IO [a]
stopChan ch = do
	closeChan ch
	whileJust (getChan ch) return