{-# OPTIONS_GHC -Wall #-}
module Test.QuickCheck.Later
( isAssocTimes
, isCommutTimes
, delay
, delayForever
) where
import Test.QuickCheck.Checkers
import Test.QuickCheck
import System.Random (Random)
import System.IO.Unsafe
import Control.Concurrent
import Control.Monad (forever)
delayP :: (Show t, Num t, System.Random.Random t, Testable b) => t -> (t -> b) -> Property
delayP :: t -> (t -> b) -> Property
delayP t
d = Gen t -> (t -> b) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll ((t, t) -> Gen t
forall a. Random a => (a, a) -> Gen a
genR (t
0,t
d))
isCommutTimes :: (EqProp b, Arbitrary a, Show a) => Double -> (a -> a -> b) -> Property
isCommutTimes :: Double -> (a -> a -> b) -> Property
isCommutTimes Double
d a -> a -> b
(#) =
Double -> (Double -> Property) -> Property
forall t b.
(Show t, Num t, Random t, Testable b) =>
t -> (t -> b) -> Property
delayP Double
d ((Double -> Property) -> Property)
-> (Double -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ Double
t1 ->
Double -> (Double -> a -> Property) -> Property
forall t b.
(Show t, Num t, Random t, Testable b) =>
t -> (t -> b) -> Property
delayP Double
d ((Double -> a -> Property) -> Property)
-> (Double -> a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ Double
t2 ->
\ a
v -> let del :: Double -> a
del = (Double -> a -> a) -> a -> Double -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Double -> a -> a
forall t a. RealFrac t => t -> a -> a
delay a
v in
Double -> a
del Double
t1 a -> a -> b
# Double -> a
del Double
t2 b -> b -> Property
forall a. EqProp a => a -> a -> Property
=-= Double -> a
del Double
t2 a -> a -> b
# Double -> a
del Double
t1
isAssocTimes :: (EqProp a, Arbitrary a, Show a) => Double -> (a -> a -> a) -> Property
isAssocTimes :: Double -> (a -> a -> a) -> Property
isAssocTimes Double
d a -> a -> a
(#) =
Double -> (Double -> Property) -> Property
forall t b.
(Show t, Num t, Random t, Testable b) =>
t -> (t -> b) -> Property
delayP Double
d ((Double -> Property) -> Property)
-> (Double -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ Double
t1 ->
Double -> (Double -> Property) -> Property
forall t b.
(Show t, Num t, Random t, Testable b) =>
t -> (t -> b) -> Property
delayP Double
d ((Double -> Property) -> Property)
-> (Double -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ Double
t2 ->
Double -> (Double -> a -> Property) -> Property
forall t b.
(Show t, Num t, Random t, Testable b) =>
t -> (t -> b) -> Property
delayP Double
d ((Double -> a -> Property) -> Property)
-> (Double -> a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ Double
t3 ->
\ a
v -> let del :: Double -> a
del = (Double -> a -> a) -> a -> Double -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Double -> a -> a
forall t a. RealFrac t => t -> a -> a
delay a
v in
(Double -> a
del Double
t1 a -> a -> a
# Double -> a
del Double
t2) a -> a -> a
# Double -> a
del Double
t3 a -> a -> Property
forall a. EqProp a => a -> a -> Property
=-= Double -> a
del Double
t1 a -> a -> a
# (Double -> a
del Double
t2 a -> a -> a
# Double -> a
del Double
t3)
eventually :: IO a -> a
eventually :: IO a -> a
eventually = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> (IO a -> IO a) -> IO a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO a
forall a. IO a -> IO a
unsafeInterleaveIO
delay :: RealFrac t => t -> a -> a
delay :: t -> a -> a
delay t
d a
a = IO a -> a
forall a. IO a -> a
eventually (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay (t -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (t
1.0e6 t -> t -> t
forall a. Num a => a -> a -> a
* t
d)) IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
delayForever :: a
delayForever :: a
delayForever = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do Any
_ <- IO () -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Int -> IO ()
threadDelay Int
forall a. Bounded a => a
maxBound)
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. HasCallStack => a
undefined