{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
module Test.Control.Concurrent.Class.MonadMVar.Strict.WHNF
( prop_newMVar
, prop_putMVar
, prop_swapMVar
, prop_tryPutMVar
, prop_modifyMVar_
, prop_modifyMVar
, prop_modifyMVarMasked_
, prop_modifyMVarMasked
, (.:)
) where
import Control.Concurrent.Class.MonadMVar.Strict
import Control.Monad (void)
import Data.Typeable (Typeable)
import NoThunks.Class (OnlyCheckWhnf (OnlyCheckWhnf), unsafeNoThunks)
import Test.QuickCheck
import Test.QuickCheck.Monadic (PropertyM, monitor, run)
infixr 9 .:
(.:) :: (y -> z) -> (x0 -> x1 -> y) -> (x0 -> x1 -> z)
.: :: forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
(.:) y -> z
g x0 -> x1 -> y
f x0
x0 x1
x1 = y -> z
g (x0 -> x1 -> y
f x0
x0 x1
x1)
isInWHNF :: (MonadMVar m, Typeable a) => StrictMVar m a -> PropertyM m Bool
isInWHNF :: forall (m :: * -> *) a.
(MonadMVar m, Typeable a) =>
StrictMVar m a -> PropertyM m Bool
isInWHNF StrictMVar m a
v = do
x <- m a -> PropertyM m a
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (m a -> PropertyM m a) -> m a -> PropertyM m a
forall a b. (a -> b) -> a -> b
$ StrictMVar m a -> m a
forall (m :: * -> *) a. MonadMVar m => StrictMVar m a -> m a
readMVar StrictMVar m a
v
case unsafeNoThunks (OnlyCheckWhnf x) of
Maybe ThunkInfo
Nothing -> Bool -> PropertyM m Bool
forall a. a -> PropertyM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
Just ThunkInfo
tinfo -> (Property -> Property) -> PropertyM m ()
forall (m :: * -> *).
Monad m =>
(Property -> Property) -> PropertyM m ()
monitor (String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String -> Property -> Property) -> String -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String
"Not in WHNF: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ThunkInfo -> String
forall a. Show a => a -> String
show ThunkInfo
tinfo)
PropertyM m () -> PropertyM m Bool -> PropertyM m Bool
forall a b. PropertyM m a -> PropertyM m b -> PropertyM m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> PropertyM m Bool
forall a. a -> PropertyM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
prop_newMVar ::
MonadMVar m
=> Int
-> Fun Int Int
-> PropertyM m Bool
prop_newMVar :: forall (m :: * -> *).
MonadMVar m =>
Int -> Fun Int Int -> PropertyM m Bool
prop_newMVar Int
x Fun Int Int
f = do
v <- m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int)
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int))
-> m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int)
forall a b. (a -> b) -> a -> b
$ Int -> m (StrictMVar m Int)
forall (m :: * -> *) a. MonadMVar m => a -> m (StrictMVar m a)
newMVar (Fun Int Int -> Int -> Int
forall a b. Fun a b -> a -> b
applyFun Fun Int Int
f Int
x)
isInWHNF v
prop_putMVar ::
MonadMVar m
=> Int
-> Fun Int Int
-> PropertyM m Bool
prop_putMVar :: forall (m :: * -> *).
MonadMVar m =>
Int -> Fun Int Int -> PropertyM m Bool
prop_putMVar Int
x Fun Int Int
f = do
v <- m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int)
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run m (StrictMVar m Int)
forall (m :: * -> *) a. MonadMVar m => m (StrictMVar m a)
newEmptyMVar
run $ putMVar v (applyFun f x)
isInWHNF v
prop_swapMVar ::
MonadMVar m
=> Int
-> Fun Int Int
-> PropertyM m Bool
prop_swapMVar :: forall (m :: * -> *).
MonadMVar m =>
Int -> Fun Int Int -> PropertyM m Bool
prop_swapMVar Int
x Fun Int Int
f = do
v <- m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int)
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int))
-> m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int)
forall a b. (a -> b) -> a -> b
$ Int -> m (StrictMVar m Int)
forall (m :: * -> *) a. MonadMVar m => a -> m (StrictMVar m a)
newMVar Int
x
void $ run $ swapMVar v (applyFun f x)
isInWHNF v
prop_tryPutMVar ::
MonadMVar m
=> Int
-> Fun Int Int
-> PropertyM m Bool
prop_tryPutMVar :: forall (m :: * -> *).
MonadMVar m =>
Int -> Fun Int Int -> PropertyM m Bool
prop_tryPutMVar Int
x Fun Int Int
f = do
v <- m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int)
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run m (StrictMVar m Int)
forall (m :: * -> *) a. MonadMVar m => m (StrictMVar m a)
newEmptyMVar
b <- run $ tryPutMVar v (applyFun f x)
b' <- isInWHNF v
pure (b && b')
prop_modifyMVar_ ::
MonadMVar m
=> Int
-> Fun Int Int
-> PropertyM m Bool
prop_modifyMVar_ :: forall (m :: * -> *).
MonadMVar m =>
Int -> Fun Int Int -> PropertyM m Bool
prop_modifyMVar_ Int
x Fun Int Int
f =do
v <- m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int)
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int))
-> m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int)
forall a b. (a -> b) -> a -> b
$ Int -> m (StrictMVar m Int)
forall (m :: * -> *) a. MonadMVar m => a -> m (StrictMVar m a)
newMVar Int
x
run $ modifyMVar_ v (pure . applyFun f)
isInWHNF v
prop_modifyMVar ::
MonadMVar m
=> Int
-> Fun Int (Int, Char)
-> PropertyM m Bool
prop_modifyMVar :: forall (m :: * -> *).
MonadMVar m =>
Int -> Fun Int (Int, Char) -> PropertyM m Bool
prop_modifyMVar Int
x Fun Int (Int, Char)
f =do
v <- m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int)
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int))
-> m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int)
forall a b. (a -> b) -> a -> b
$ Int -> m (StrictMVar m Int)
forall (m :: * -> *) a. MonadMVar m => a -> m (StrictMVar m a)
newMVar Int
x
void $ run $ modifyMVar v (pure . applyFun f)
isInWHNF v
prop_modifyMVarMasked_ ::
MonadMVar m
=> Int
-> Fun Int Int
-> PropertyM m Bool
prop_modifyMVarMasked_ :: forall (m :: * -> *).
MonadMVar m =>
Int -> Fun Int Int -> PropertyM m Bool
prop_modifyMVarMasked_ Int
x Fun Int Int
f =do
v <- m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int)
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int))
-> m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int)
forall a b. (a -> b) -> a -> b
$ Int -> m (StrictMVar m Int)
forall (m :: * -> *) a. MonadMVar m => a -> m (StrictMVar m a)
newMVar Int
x
void $ run $ modifyMVarMasked_ v (pure . applyFun f)
isInWHNF v
prop_modifyMVarMasked ::
MonadMVar m
=> Int
-> Fun Int (Int, Char)
-> PropertyM m Bool
prop_modifyMVarMasked :: forall (m :: * -> *).
MonadMVar m =>
Int -> Fun Int (Int, Char) -> PropertyM m Bool
prop_modifyMVarMasked Int
x Fun Int (Int, Char)
f =do
v <- m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int)
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int))
-> m (StrictMVar m Int) -> PropertyM m (StrictMVar m Int)
forall a b. (a -> b) -> a -> b
$ Int -> m (StrictMVar m Int)
forall (m :: * -> *) a. MonadMVar m => a -> m (StrictMVar m a)
newMVar Int
x
void $ run $ modifyMVarMasked v (pure . applyFun f)
isInWHNF v