module Test.DejaFu.STM
(
STMLike
, STMST
, STMIO
, Result(..)
, TTrace
, TAction(..)
, TVarId
, runTransaction
) where
import Control.Applicative (Alternative(..))
import Control.Monad (MonadPlus(..), unless)
import Control.Monad.Catch (MonadCatch(..), MonadThrow(..))
import Control.Monad.Ref (MonadRef)
import Control.Monad.ST (ST)
import Data.IORef (IORef)
import Data.STRef (STRef)
import qualified Control.Monad.STM.Class as C
import Test.DejaFu.Common
import Test.DejaFu.STM.Internal
#if MIN_VERSION_base(4,9,0)
import qualified Control.Monad.Fail as Fail
#endif
newtype STMLike n r a = S { runSTM :: M n r a } deriving (Functor, Applicative, Monad)
#if MIN_VERSION_base(4,9,0)
instance Fail.MonadFail (STMLike r n) where
fail = S . fail
#endif
toSTM :: ((a -> STMAction n r) -> STMAction n r) -> STMLike n r a
toSTM = S . cont
type STMST t = STMLike (ST t) (STRef t)
type STMIO = STMLike IO IORef
instance MonadThrow (STMLike n r) where
throwM = toSTM . const . SThrow
instance MonadCatch (STMLike n r) where
catch (S stm) handler = toSTM (SCatch (runSTM . handler) stm)
instance Alternative (STMLike n r) where
S a <|> S b = toSTM (SOrElse a b)
empty = toSTM (const SRetry)
instance MonadPlus (STMLike n r)
instance C.MonadSTM (STMLike n r) where
type TVar (STMLike n r) = TVar r
#if MIN_VERSION_concurrency(1,2,0)
#else
retry = empty
orElse = (<|>)
#endif
newTVarN n = toSTM . SNew n
readTVar = toSTM . SRead
writeTVar tvar a = toSTM (\c -> SWrite tvar a (c ()))
runTransaction :: MonadRef r n
=> STMLike n r a -> IdSource -> n (Result a, IdSource, TTrace)
runTransaction ma tvid = do
(res, undo, tvid', trace) <- doTransaction (runSTM ma) tvid
unless (isSTMSuccess res) undo
pure (res, tvid', trace)