barrucadu/dejafu
1
1
Fork 0
mirror of https://github.com/barrucadu/dejafu.git synced 2025-01-05 12:15:12 +03:00
Code Issues Projects Releases Wiki Activity

STMLike type synonyms to shrink type sigs

Browse Source
This commit is contained in:
Michael Walker 2015-05-09 19:56:54 +01:00
parent 0a4bdeee68
commit 192777c2c9
1 changed files with 11 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
Test/DejaFu/STM.hs
View File

@ -7,6 +7,8 @@
module Test.DejaFu.STM module Test.DejaFu.STM
( -- * The @STMLike@ Monad ( -- * The @STMLike@ Monad
STMLike STMLike
, STMST
, STMIO
, Result(..) , Result(..)
, runTransaction , runTransaction
, runTransactionST , runTransactionST
@ -46,6 +48,12 @@ import qualified Control.Monad.STM.Class as C
-- reason). -- reason).
newtype STMLike t n r a = S { unS :: M t n r a } deriving (Functor, Applicative, Monad) newtype STMLike t n r a = S { unS :: M t n r a } deriving (Functor, Applicative, Monad)
-- | A convenience wrapper around 'STMLike' using 'STRef's.
type STMST t a = STMLike t (ST t) (STRef t) a
-- | A convenience wrapper around 'STMLike' using 'IORef's.
type STMIO t a = STMLike t IO IORef a
instance Monad n => MonadThrow (STMLike t n r) where instance Monad n => MonadThrow (STMLike t n r) where
throwM = throwSTM throwM = throwSTM
@ -101,13 +109,13 @@ writeCTVar ctvar a = S $ cont $ \c -> AWrite ctvar a $ c ()
-- environment, and discarding the environment afterwards. This is -- environment, and discarding the environment afterwards. This is
-- suitable for testing individual transactions, but not for composing -- suitable for testing individual transactions, but not for composing
-- multiple ones. -- multiple ones.
runTransaction :: (forall t. STMLike t (ST t) (STRef t) a) -> Result a runTransaction :: (forall t. STMST t a) -> Result a
runTransaction ma = fst $ runST $ runTransactionST ma 0 runTransaction ma = fst $ runST $ runTransactionST ma 0
-- | Run a transaction in the 'ST' monad, returning the result and new -- | Run a transaction in the 'ST' monad, returning the result and new
-- initial 'CTVarId'. If the transaction ended by calling 'retry', any -- initial 'CTVarId'. If the transaction ended by calling 'retry', any
-- 'CTVar' modifications are undone. -- 'CTVar' modifications are undone.
runTransactionST :: STMLike t (ST t) (STRef t) a -> CTVarId -> ST t (Result a, CTVarId) runTransactionST :: STMST t a -> CTVarId -> ST t (Result a, CTVarId)
runTransactionST ma ctvid = do runTransactionST ma ctvid = do
(res, undo, ctvid') <- doTransaction fixedST (unS ma) ctvid (res, undo, ctvid') <- doTransaction fixedST (unS ma) ctvid
@ -122,7 +130,7 @@ runTransactionST ma ctvid = do
-- | Run a transaction in the 'IO' monad, returning the result and new -- | Run a transaction in the 'IO' monad, returning the result and new
-- initial 'CTVarId'. If the transaction ended by calling 'retry', any -- initial 'CTVarId'. If the transaction ended by calling 'retry', any
-- 'CTVar' modifications are undone. -- 'CTVar' modifications are undone.
runTransactionIO :: STMLike t IO IORef a -> CTVarId -> IO (Result a, CTVarId) runTransactionIO :: STMIO t a -> CTVarId -> IO (Result a, CTVarId)
runTransactionIO ma ctvid = do runTransactionIO ma ctvid = do
(res, undo, ctvid') <- doTransaction fixedIO (unS ma) ctvid (res, undo, ctvid') <- doTransaction fixedIO (unS ma) ctvid