module Control.Concurrent.Chan.Split (
InChan()
, OutChan()
, getChanContents
, dupChan
, module Control.Concurrent.Chan.Class
) where
import System.IO.Unsafe ( unsafeInterleaveIO )
import Control.Concurrent.MVar
import Control.Exception (mask_)
import Data.Typeable
import Control.Concurrent.Chan.Class
type Stream a = MVar (ChItem a)
data ChItem a = ChItem a (Stream a)
newtype InChan i = InChan (MVar (Stream i))
deriving (Eq, Typeable)
newtype OutChan i = OutChan (MVar (Stream i))
deriving (Eq, Typeable)
instance NewSplitChan InChan OutChan where
newSplitChan = do
hole <- newEmptyMVar
readVar <- newMVar hole
writeVar <- newMVar hole
return ( InChan writeVar, OutChan readVar )
instance SplitChan InChan OutChan where
writeChan (InChan writeVar) val = do
new_hole <- newEmptyMVar
mask_ $ do
old_hole <- takeMVar writeVar
putMVar old_hole (ChItem val new_hole)
putMVar writeVar new_hole
writeList2Chan ch ls = sequence_ (map (writeChan ch) ls)
readChan (OutChan readVar) = do
modifyMVar readVar $ \read_end -> do
(ChItem val new_read_end) <- readMVar read_end
return (new_read_end, val)
getChanContents :: OutChan a -> IO [a]
getChanContents ch = unsafeInterleaveIO (do
x <- readChan ch
xs <- getChanContents ch
return (x:xs)
)
dupChan :: OutChan a -> IO (OutChan a)
dupChan (OutChan writeVar) = OutChan `fmap` withMVar writeVar newMVar