-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Monad.AdvSTM.Class
-- Copyright   :  (c) HaskellWiki 2006-2007, Peter Robinson 2008
-- License     :  BSD3
-- 
-- Maintainer  :  Peter Robinson <robinson@ecs.tuwien.ac.at>
-- Stability   :  experimental
-- Portability :  non-portable (requires STM)
--
-- Provides the type class MonadAdvSTM 
-- Parts of this implementation were taken from the HaskellWiki Page of
-- MonadAdvSTM (see package description).
-----------------------------------------------------------------------------

module Control.Monad.AdvSTM.Class( MonadAdvSTM(..), TVar(TVar), valueTVar, onCommitLock, currentTid )
where

import Control.Exception(Exception)
import qualified Control.Concurrent.STM as S
import qualified Control.Concurrent.STM.TVar as OldTVar
import qualified Control.Concurrent.STM.TMVar as OldTMVar
import Control.Monad(Monad)
-- import Control.Monad.AdvSTM.Def(AdvSTM)
import Control.Concurrent( ThreadId )
--import GHC.Conc( unsafeIOToSTM )
-- import {-# SOURCE #-} Control.Concurrent.AdvSTM.TVar


data TVar a = TVar 
    { valueTVar    :: OldTVar.TVar a     
    , onCommitLock :: OldTMVar.TMVar ()  
    , currentTid   :: OldTVar.TVar (Maybe ThreadId)
    }

-- | A type class for extended-STM monads. For a concrete instantiation see
-- 'AdvSTM'
class Monad m => MonadAdvSTM m where

    -- | Takes an IO action that will be executed /iff/ the transaction commits. 
    -- 
    -- * When a TVar was modified in a transaction and this transaction commits,
    -- this update remains invisible to other threads until the corresponding 
    -- onCommit action was run. 
    --
    -- * If the onCommit action throws an exception, the original value of 
    -- the TVars  will be restored.
    --
    -- * Accessing a modified TVar within the onCommit action will cause a
    -- Deadlock exception to be thrown. 
    --
    -- As a general rule, 'onCommit' should 
    -- only be used for \"real\" (i.e. without atomic blocks) IO actions and is certainly
    -- not the right place to fiddle with TVars. For example, if you wanted to
    -- write a TVar value to a file on commit, you could write:
    -- 
    -- > tvar <- newTVarIO "bla"
    -- > atomically $ do 
    -- >    x <- readTVar tvar 
    -- >    onCommit (writeFile "myfile" x)
    -- 
    --
    onCommit  :: IO () -> m ()

    -- | Adds an IO action to the retry job-queue. If the transaction retries,
    -- a new helper thread is forked that runs the retry actions, and, after the helper 
    -- thread is done, the transaction retries.
    -- 
    -- Uses 'unsafeIOToSTM' to fork a helper thread that runs the retry 
    -- actions.  
    onRetry :: IO () -- ^ IO action that will be run on retry the transaction.
                  -> m ()

    -- | See 'S.orElse'
    orElse :: m a -> m a -> m a

    -- | Runs any IO actions added by 'onRetry' and then retries the
    -- transaction.
    retry  :: m a

    -- | See 'S.check'
    check :: Bool -> m ()

    -- | See 'S.alwaysSucceeds'
    alwaysSucceeds :: m a -> m ()

    -- | See 'S.always'
    always :: m Bool -> m ()

    -- | Runs a transaction atomically in the 'IO' monad. 
    runAtomic :: m a -> IO a

    -- | See 'S.catchSTM'
    catchSTM  :: Exception e => m a -> (e -> m a) -> m a

    -- | Lifts STM actions to 'MonadAdvSTM'.
    liftAdv   :: S.STM a -> m a
 
    -- | Reads a value from a TVar. Blocks until the IO onCommit action(s) of 
    -- the corresponding transaction are complete.
    -- See 'onCommit' for a more detailed description of this behaviour.
    readTVar :: TVar a -> m a

    -- | Writes a value to a TVar. Blocks until the onCommit IO-action(s) are
    -- complete. See 'onCommit' for details.
    writeTVar :: TVar a -> a -> m ()

    -- | See 'OldTVar.newTVar'
    newTVar :: a -> m (TVar a)

--    newTVarIO :: a -> IO (TVar a)