module Control.Concurrent.FiniteChan (
Chan,
newChan, dupChan, openedChan, closedChan, doneChan, sendChan, putChan, getChan, readChan, closeChan, stopChan
) where
import Control.Monad (void, when, liftM2)
import qualified Control.Concurrent.Chan as C
import Control.Concurrent.MVar
import Data.Maybe
data State = Opened | Closing | Closed deriving (Eq, Ord, Enum, Bounded, Read, Show)
data Chan a = Chan (C.Chan (Maybe a)) (MVar State)
newChan :: IO (Chan a)
newChan = liftM2 Chan C.newChan (newMVar Opened)
dupChan :: Chan a -> IO (Chan a)
dupChan (Chan ch st) = liftM2 Chan (C.dupChan ch) (return st)
openedChan :: Chan a -> IO Bool
openedChan (Chan _ st) = (== Opened) <$> readMVar st
closedChan :: Chan a -> IO Bool
closedChan (Chan _ st) = (/= Opened) <$> readMVar st
doneChan :: Chan a -> IO Bool
doneChan (Chan _ st) = (== Closed) <$> readMVar st
sendChan :: Chan a -> a -> IO Bool
sendChan (Chan ch st) v = do
state <- readMVar st
if state == Opened
then do
C.writeChan ch (Just v)
return True
else return False
putChan :: Chan a -> a -> IO ()
putChan ch = void . sendChan ch
getChan :: Chan a -> IO (Maybe a)
getChan (Chan ch st) = do
state <- readMVar st
if state == Closed then return Nothing else do
r <- C.readChan ch
when (isNothing r) (void $ swapMVar st Closed)
return r
readChan :: Chan a -> IO [a]
readChan (Chan ch _) = (catMaybes . takeWhile isJust) <$> C.getChanContents ch
closeChan :: Chan a -> IO ()
closeChan (Chan ch st) = do
state <- readMVar st
when (state == Opened) $ do
_ <- swapMVar st Closing
C.writeChan ch Nothing
stopChan :: Chan a -> IO [a]
stopChan ch = closeChan ch >> readChan ch