Я хочу написать функцию, которая берет ограничение по времени (в секундах) и список, и вычисляет столько элементов списка, сколько возможно за этот срок.

Моей первой попыткой было сначала написать следующую функцию, которая рассчитывает чистые вычисления и возвращает прошедшее время вместе с результатом:

import Control.DeepSeq
import System.CPUTime

type Time = Double

timed :: (NFData a) => a -> IO (a, Time)
timed x = do t1 <- getCPUTime
             r  <- return $!! x
             t2 <- getCPUTime
             let diff = fromIntegral (t2 - t1) / 10^12
             return (r, diff)

Затем я могу определить функцию, которую я хочу, с точки зрения этого:

timeLimited :: (NFData a) => Time -> [a] -> IO [a]
timeLimited remaining []     = return []
timeLimited remaining (x:xs) = if remaining < 0
    then return []
    else do
        (y,t) <- timed x
        ys    <- timeLimited (remaining - t) xs
        return (y:ys)

Это не совсем правильно, хотя. Даже игнорируя ошибки синхронизации и ошибки с плавающей запятой, этот подход никогда не останавливает вычисление элемента списка после его запуска, а это означает, что он может (и на самом деле обычно будет) превышать свой лимит времени.

Если бы вместо этого у меня была функция, которая могла бы замкнуть оценку, если бы она заняла слишком много времени:

timeOut :: Time -> a -> IO (Maybe (a,t))
timeOut = undefined

тогда я мог бы написать функцию, которую яreally хочу:

timeLimited' :: Time -> [a] -> IO [a]
timeLimited' remaining []     = return []
timeLimited' remaining (x:xs) = do
    result <- timeOut remaining x
    case result of
        Nothing    -> return []
        Just (y,t) -> do
            ys <- timeLimited' (remaining - t) xs
            return (y:ys)

Мои вопросы:

How do I write timeOut? Is there a better way to write the function timeLimited, for example, one that doesn't suffer from accumulated floating point error from adding up time differences multiple times?