-- |
-- Module      : Test.Speculate.Utils.Timeout
-- Copyright   : (c) 2016-2019 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- This module is part of Speculate.
--
-- Evaluate values to WHNF until a timeout.
module Test.Speculate.Utils.Timeout
  ( timeoutToNothing
  , fromTimeout
  , timeoutToFalse
  , timeoutToTrue
  , timeoutToError
  )
where

import System.IO.Unsafe (unsafePerformIO)
import Control.Exception (evaluate)
import System.Timeout
import Data.Maybe (fromMaybe)

-- TODO: Move this into LeanCheck?

-- | In microseconds
usTimeoutToNothing :: Int -> a -> Maybe a
usTimeoutToNothing :: Int -> a -> Maybe a
usTimeoutToNothing Int
n = IO (Maybe a) -> Maybe a
forall a. IO a -> a
unsafePerformIO (IO (Maybe a) -> Maybe a) -> (a -> IO (Maybe a)) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO a -> IO (Maybe a)
forall a. Int -> IO a -> IO (Maybe a)
timeout Int
n (IO a -> IO (Maybe a)) -> (a -> IO a) -> a -> IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall a. a -> IO a
evaluate

-- | Returns Nothing if value cannot be evaluated to WHNF in a given number of seconds
timeoutToNothing :: RealFrac s => s -> a -> Maybe a
timeoutToNothing :: s -> a -> Maybe a
timeoutToNothing s
n = Int -> a -> Maybe a
forall a. Int -> a -> Maybe a
usTimeoutToNothing (Int -> a -> Maybe a) -> Int -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ s -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (s
n s -> s -> s
forall a. Num a => a -> a -> a
* s
1000000)

fromTimeout :: RealFrac s => s -> a -> a -> a
fromTimeout :: s -> a -> a -> a
fromTimeout s
n a
x = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
x (Maybe a -> a) -> (a -> Maybe a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> a -> Maybe a
forall s a. RealFrac s => s -> a -> Maybe a
timeoutToNothing s
n

timeoutToFalse :: RealFrac s => s -> Bool -> Bool
timeoutToFalse :: s -> Bool -> Bool
timeoutToFalse s
n = s -> Bool -> Bool -> Bool
forall s a. RealFrac s => s -> a -> a -> a
fromTimeout s
n Bool
False

timeoutToTrue :: RealFrac s => s -> Bool -> Bool
timeoutToTrue :: s -> Bool -> Bool
timeoutToTrue s
n = s -> Bool -> Bool -> Bool
forall s a. RealFrac s => s -> a -> a -> a
fromTimeout s
n Bool
True

timeoutToError :: RealFrac s => s -> a -> a
timeoutToError :: s -> a -> a
timeoutToError s
n = s -> a -> a -> a
forall s a. RealFrac s => s -> a -> a -> a
fromTimeout s
n ([Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"timeoutToError: timed out")