module Control.Concurrent.STM.Split.MVar (
   T,
   In,
   Out,
   newEmptyIO,
   newEmpty,
   newIO,
   new,
   take, tryTake,
   put, tryPut,
{-
   write,
   clear,
-}
   ) where

import qualified Control.Concurrent.STM.Split.Class as Split

import qualified Control.Concurrent.STM.TMVar as MVar
import Control.Monad.STM (STM, )

import Prelude (IO, Maybe, Bool, return, )


newtype T dir a = Cons (MVar.TMVar a)

type In  = T Split.In
type Out = T Split.Out


instance Split.C T where
   newIO = newEmptyIO
   new = newEmpty
   read = take
   write = put

newEmptyIO :: IO (In a, Out a)
newEmptyIO = do
   v <- MVar.newEmptyTMVarIO
   return (Cons v, Cons v)

newEmpty :: STM (In a, Out a)
newEmpty = do
   v <- MVar.newEmptyTMVar
   return (Cons v, Cons v)

newIO :: a -> IO (In a, Out a)
newIO a = do
   v <- MVar.newTMVarIO a
   return (Cons v, Cons v)

new :: a -> STM (In a, Out a)
new a = do
   v <- MVar.newTMVar a
   return (Cons v, Cons v)

take :: Out a -> STM a
take (Cons v) = MVar.takeTMVar v

tryTake :: Out a -> STM (Maybe a)
tryTake (Cons v) = MVar.tryTakeTMVar v

put :: In a -> a -> STM ()
put (Cons v) a = MVar.putTMVar v a

tryPut :: In a -> a -> STM Bool
tryPut (Cons v) a = MVar.tryPutTMVar v a


{-
write :: In a -> a -> STM ()
write var a =
   clear var >> put var a

clear :: In a -> STM ()
clear (Cons v) =
   MVar.tryTakeTMVar v >> return ()
-}