Operations.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Concurrent.TBox.Operations
-- Copyright   :  Peter Robinson 2009
-- License     :  LGPL
--
-- Maintainer  :  Peter Robinson <thaldyron@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable (requires STM)
--
-- Operations on instances of 'TBox'.
--
-----------------------------------------------------------------------------
module Control.Concurrent.TBox.Operations
where
import Control.Concurrent.TBox.Class
import Control.Monad
import Control.Concurrent.AdvSTM
import Data.Maybe

import Prelude hiding(lookup,catch,null,read,readIO,writeFile)


--------------------------------------------------------------------------------

-- | Deletes the content.
delete :: (TBox t a) => t a -> AdvSTM ()
delete tbox = do
  deleteSTM tbox 
  setDirty tbox False
  onCommit $ deleteIO tbox

-- | Writes the new content.
write :: (TBox t a) => t a  -> a -> AdvSTM ()
write tbox a = do
  writeSTM tbox a  
  setDirty tbox False
  onCommit $ writeIO tbox a

-- | If the TBox is dirty, this retries the transaction and
-- rereads the content using 'readIO' in a separate thread.
-- Otherwise it simply returns the result of 'readSTM'.
--
-- Note: Depending on the implementation, careless 
-- use of 'setDirty' and 'read' in the same transaction might lead
-- to nonterminating retry loops.
read :: TBox t a => t a -> AdvSTM (Maybe a)
read tbox = do
  dirty <- isDirty tbox
  if dirty 
    then unsafeRetryWith $ do 
      mvalIO <- readIO tbox 
      atomically $ do
        stillDirty <- isDirty tbox
        when stillDirty $ do
          setDirty tbox False
          case mvalIO of
            Nothing -> deleteSTM tbox 
            Just v  -> writeSTM tbox v 
    else 
      readSTM tbox

-- | Returns 'True' iff the 'TBox' is empty.
isEmpty  :: TBox t a => t a -> AdvSTM Bool
isEmpty = liftM isJust . readSTM