module Test.Framework.Runners.TimedConsumption (
        consumeListInInterval
    ) where

import Test.Framework.Utilities

import System.CPUTime ( getCPUTime )


-- | Evaluates the given list for the given number of microseconds. After the time limit
-- has been reached, a list is returned consisting of the prefix of the list that was
-- successfully evaluated within the time limit.
--
-- This function does /not/ evaluate the elements of the list: it just ensures that the
-- list spine arrives in good order.
--
-- The spine of the list is evaluated on the current thread, so if spine evaluation blocks
-- this function will also block, potentially for longer than the specificed delay.
consumeListInInterval :: Int -> [a] -> IO [a]
consumeListInInterval :: forall a. Int -> [a] -> IO [a]
consumeListInInterval Int
delay [a]
list = do
    Integer
initial_time_ps <- IO Integer
getCPUTime
    Integer -> Integer -> [a] -> IO [a]
forall {a}. Integer -> Integer -> [a] -> IO [a]
go Integer
initial_time_ps (Integer -> Integer
forall a. Num a => a -> a
microsecondsToPicoseconds (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
delay)) [a]
list
  where
    go :: Integer -> Integer -> [a] -> IO [a]
go Integer
_               Integer
_        []     = [a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    go Integer
initial_time_ps Integer
delay_ps (a
x:[a]
xs) = do
        Integer
this_time <- IO Integer
getCPUTime
        if Integer
this_time Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
initial_time_ps Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
delay_ps
         then Integer -> Integer -> [a] -> IO [a]
go Integer
initial_time_ps Integer
delay_ps [a]
xs IO [a] -> ([a] -> IO [a]) -> IO [a]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> IO [a]) -> ([a] -> [a]) -> [a] -> IO [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)
         else [a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []