{-# OPTIONS_GHC -Wall #-}
----------------------------------------------------------------------
-- |
-- Module      :  Data.Later
-- Copyright   :  (c) David Sankel 2008
-- License     :  BSD3
--
-- Maintainer  :  david@sankelsoftware.com
-- Stability   :  experimental
--
-- Later. Allows for testing of functions that depend on the order of
-- evaluation.
--
-- TODO: move this functionality to the testing package for Unamb.
----------------------------------------------------------------------

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)

-- Generate a random delay up to given max seconds for a property.
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))

-- | Is the given function commutative when restricted to the same value
-- but possibly different times?
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

-- Note that we delay v by t1 and by t2 twice.
--
-- TODO: make sure CSE isn't kicking in.  Examine the core code.

-- | Is the given function associative when restricted to the same value
-- but possibly different times?
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)


-- The value eventually returned by an action.  Probably handy elsewhere.
-- TODO: what are the necessary preconditions in order to make this
-- function referentially transparent?
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

-- Why unsafeInterleaveIO?  Because ...

-- | Delay a value's availability by the given duration in seconds.
-- Note that the delay happens only on the first evaluation.
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

-- | A value that is never available.  Rerun of @hang@ from unamb, but
-- replicated to avoid mutual dependency.
--
-- TODO: Remove when this module is moved into the unamb-test package.
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