{-# LANGUAGE ExistentialQuantification, GeneralizedNewtypeDeriving #-}
module Control.Monad.AdvSTM.Def(AdvSTM(..),Env(..),TVarValue(..))
where
import qualified Control.Concurrent.STM as S
import Control.Concurrent.STM.TVar(TVar)
import Control.Concurrent.STM.TMVar(TMVar)
import Control.Concurrent(MVar,ThreadId)
import Control.Applicative(Alternative,(<|>),(<*>),empty)
import Control.Monad(Monad,MonadPlus,ap,liftM,mplus,mzero)
import Control.Monad.Reader(ReaderT,mapReaderT,runReaderT)
instance Functor AdvSTM where
fmap = liftM
instance Applicative AdvSTM where
pure = return
(<*>) = ap
instance Alternative AdvSTM where
(<|>) = mplus
empty = mzero
newtype AdvSTM a = AdvSTM (ReaderT Env S.STM a)
deriving ( Monad
, MonadPlus
)
data Env = Env { commitTVar :: TVar [IO ()]
, commitClosure :: TVar ([IO ()] -> IO ())
, retryDoneMVar :: MVar (Maybe ())
, transThreadId :: ThreadId
, listeners :: TVar [(TMVar (),TVarValue)]
, debugModeVar :: TVar Bool
}
data TVarValue = forall a. TVarValue ((TVar a),a)