-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Concurrent.TBox.Internal.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.Internal.Operations
where
import Control.Concurrent.TBox.Internal.Class
import Control.Monad
import Control.Concurrent.AdvSTM
import Data.Maybe
import Control.Monad.Loops

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


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

-- | Deletes the content.
clear :: (TBox t k a) => t k a -> AdvSTM ()
clear tbox = do
  clearSTM tbox 
  setDirty tbox False
  onCommit $ clearIO tbox

-- | Writes the new content.
write :: (TBox t k a) => t k 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 instance implementation, careless 
-- use of 'setDirty' and 'read' in the same transaction might lead
-- to nonterminating retry loops.
read :: TBox t k a => t k a -> AdvSTM (Maybe a)
read tbox = do
  dirty <- isDirty tbox
  if dirty 
    then unsafeRetryWith $ do 
      !mvalIO <- readIO tbox 
--      print "retrying"
      atomically $ do
        stillDirty <- isDirty tbox
        when stillDirty $ do
          setDirty tbox False
          case mvalIO of
            Nothing -> clearSTM tbox 
            Just v  -> writeSTM tbox v 
    else 
      readSTM tbox

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

-- | Returns 'True' iff the 'TBox' is empty and not dirty.
isEmptyNotDirty :: TBox t k a => t k a -> AdvSTM Bool
isEmptyNotDirty t = andM [isEmpty t,isDirty t]