-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Concurrent.TBox.Class
-- Copyright   :  Peter Robinson 2009
-- License     :  LGPL
--
-- Maintainer  :  Peter Robinson <thaldyron@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable (requires STM)
--
-- The type class 'TBox'.
-- 
--
-----------------------------------------------------------------------------
module Control.Concurrent.TBox.Class
where
import Control.Concurrent.AdvSTM
import Prelude hiding(readIO)

--------------------------------------------------------------------------------
-- | An instance of 'TBox' is a (Adv)STM variable that might contain a value of 
-- some type 'a'. In contrast to a plain 'TVar', a 
-- 'TBox' has IO hooks that are executed transparently on updates and reads.
-- The functions of the type class shouldn't be exposed directly but should be used via
-- the interface defined in the module 'TBox.Operations'.
-- 
-- See the module 'TFile' for a concrete instantiation.
class TBox t a where
  writeSTM :: t a -> a -> AdvSTM ()
  writeIO  :: t a -> a -> IO () 

  readSTM  :: t a -> AdvSTM (Maybe a)
  -- | Note: Might be executed multiple times for the
  -- same 'TBox' in a single transaction. See 'unsafeRetryWith'.
  readIO   :: t a -> IO (Maybe a)

  deleteSTM :: t a -> AdvSTM ()
  deleteIO :: t a -> IO ()

  -- | If 'isDirty' yields 'True', the 'readIO' hook will be run on the next
  -- read.
  isDirty  :: t a -> AdvSTM Bool
  setDirty :: t a -> Bool -> AdvSTM ()

--  modifySTM :: t a -> (a -> a) -> AdvSTM ()
--  modifySTM t f = readSTM t >>= writeSTM t . f
--  modifyIO  :: t a -> (a -> a) -> AdvSTM ()
--  modifyIO t f = readIO t >>=