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
data Chan a = Chan {
chanOpened :: TMVar Bool,
chanQueue :: TQueue a }
newChan :: IO (Chan a)
newChan = liftM2 Chan (newTMVarIO True) newTQueueIO
openedChan :: Chan a -> IO Bool
openedChan = atomically . readTMVar . chanOpened
closedChan :: Chan a -> IO Bool
closedChan = fmap not . openedChan
doneChan :: Chan a -> IO Bool
doneChan ch = atomically $ do
o <- readTMVar $ chanOpened ch
e <- isEmptyTQueue (chanQueue ch)
return $ not o && e
sendChan :: Chan a -> a -> IO Bool
sendChan ch v = atomically $ do
o <- readTMVar $ chanOpened ch
when o $ writeTQueue (chanQueue ch) v
return o
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)
closeChan :: Chan a -> IO ()
closeChan ch = atomically $ void $ swapTMVar (chanOpened ch) False
stopChan :: Chan a -> IO [a]
stopChan ch = do
closeChan ch
whileJust (getChan ch) return