{-# OPTIONS -fglasgow-exts #-}
-- {-# LANGUAGE MagicHash #-}
-- {-# LANGUAGE Rank2Types #-}
-- {-# LANGUAGE ImpredicativeTypes #-} -- this options is not supported under GHC 6.8

module Control.Concurrent.FullSession.UChan (Channel, newUChan, outUChan, inUChan, closeUChan) where

import Control.Concurrent
import Control.Concurrent.MVar
import GHC.Exts
import Control.Concurrent.FullSession.Misc

newtype Channel t n = C (forall a . a ->IO () , forall a . IO a, IO ())

dangerCoerce1 :: (a -> IO ()) -> (forall a. a -> IO ())
dangerCoerce1 f = unsafeCoerce# f

dangerCoerce2 :: IO a -> (forall a. IO a)
dangerCoerce2 m = unsafeCoerce# m

put mv v = do
  mv' <- takeMVar mv
  putMVar mv' v

get mv = do
  mv' <- newEmptyMVar
  putMVar mv mv'
  takeMVar mv'

newUChan :: IO (Channel t n)
newUChan = newEmptyMVar >>= \mv -> return  $ C (dangerCoerce1 $ put mv, dangerCoerce2 $ get mv, return ())

outUChan :: Channel t n -> v -> IO ()
outUChan (C (o,_,_)) v = o v
inUChan :: Channel t n -> IO v
inUChan (C (_,i,_)) = i
closeUChan :: Channel t n -> IO ()
closeUChan (C (_,_,c)) = c