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
    initial_time_ps <- IO Integer
getCPUTime
    go initial_time_ps (microsecondsToPicoseconds (fromIntegral delay)) 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
        this_time <- IO Integer
getCPUTime
        if this_time - initial_time_ps < delay_ps
         then go initial_time_ps delay_ps xs >>= return . (x:)
         else return []