1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
|
module TestSuite.Util.StrictMVar (
MVar -- opaque
, newMVar
, CC.withMVar
, modifyMVar
, modifyMVar_
, CC.readMVar
) where
import Control.Concurrent (MVar)
import Control.Exception
import qualified Control.Concurrent as CC
newMVar :: a -> IO (MVar a)
newMVar x = CC.newMVar =<< evaluate x
modifyMVar :: MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar mv f = CC.modifyMVar mv $ \old -> do
(new, ret) <- f old
new' <- evaluate new
return (new', ret)
modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()
modifyMVar_ mv f = modifyMVar mv (returnUnit . f)
where
returnUnit :: IO a -> IO (a, ())
returnUnit = fmap $ \a -> (a, ())
|
