TwoWayChannel.hs

module Nettle.Servers.TwoWayChannel (
  Chan2,
  whenDead,
  kill,
  newChan2, 
  readChan2,
  writeChan2,
  getChanContents2,
  writeList2Chan2,
  theOtherEnd2
  ) where

import Control.Concurrent

data Chan2 a b c = Chan2 {inCh::Chan a, outCh::Chan b, deadVar :: MVar c}


whenDead :: Chan2 a b c -> IO c
whenDead mch2 = readMVar (deadVar mch2)

kill :: Chan2 a b c -> c -> IO ()
kill mch c = putMVar (deadVar mch) c


newChan2 :: IO (Chan2 a b c)
newChan2 = do
  i <- newChan
  o <- newChan
  d <- newEmptyMVar
  return $ Chan2 {inCh=i, outCh=o, deadVar=d}

readChan2 :: Chan2 a b c -> IO a
readChan2 (Chan2 inC outC _)  = readChan inC

writeChan2 :: Chan2 a b c -> b -> IO ()
writeChan2 (Chan2 inC outC _) = writeChan outC

getChanContents2 :: Chan2 a b c -> IO [a]
getChanContents2 (Chan2 inC _ _) = getChanContents inC

writeList2Chan2 :: Chan2 a b c -> [b] -> IO ()
writeList2Chan2 (Chan2 _ outCh _) bs = writeList2Chan outCh bs

isEmptyChan2 :: Chan2 a b c -> IO Bool
isEmptyChan2 (Chan2 inCh _ _) = isEmptyChan inCh

theOtherEnd2 :: Chan2 a b c -> Chan2 b a c
theOtherEnd2 (Chan2 inC outC d) = Chan2 outC inC d


connect2 :: Chan2 a b c -> Chan2 b a c -> IO ()
connect2 (Chan2 inC outC _) (Chan2 inC' outC' _) = do
  forkIO $ (readChan inC >>= writeChan outC')
  forkIO $ (readChan inC' >>= writeChan outC)
  return ()