module System.SimpleTimeout.Limits
( TimeLimit
, SizeLimit
, Budget
, newBudget
, checkBudget
, decSizeBudget
, showTimeout
) where
import System.SimpleTimeout (TimeoutHandle, timeoutHandle, timeout)
import Control.Concurrent.MVar (MVar, newMVar, modifyMVar)
type TimeLimit = Double
type SizeLimit = Int
data Budget
= Budget TimeoutHandle (MVar SizeLimit)
newBudget :: TimeLimit -> SizeLimit -> IO Budget
newBudget :: TimeLimit -> SizeLimit -> IO Budget
newBudget TimeLimit
t SizeLimit
s = do
TimeoutHandle
th <- TimeLimit -> IO TimeoutHandle
timeoutHandle TimeLimit
t
MVar SizeLimit
mv <- SizeLimit -> IO (MVar SizeLimit)
forall a. a -> IO (MVar a)
newMVar SizeLimit
s
Budget -> IO Budget
forall (m :: * -> *) a. Monad m => a -> m a
return (Budget -> IO Budget) -> Budget -> IO Budget
forall a b. (a -> b) -> a -> b
$ TimeoutHandle -> MVar SizeLimit -> Budget
Budget TimeoutHandle
th MVar SizeLimit
mv
checkBudget
:: Budget
-> Int
-> (Double -> IO a)
-> IO a
-> IO a
-> IO a
checkBudget :: Budget -> SizeLimit -> (TimeLimit -> IO a) -> IO a -> IO a -> IO a
checkBudget (Budget TimeoutHandle
tb MVar SizeLimit
sb) SizeLimit
dec TimeLimit -> IO a
ta IO a
sa IO a
na = do
Bool
r <- MVar SizeLimit -> (SizeLimit -> IO (SizeLimit, Bool)) -> IO Bool
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar SizeLimit
sb ((SizeLimit -> IO (SizeLimit, Bool)) -> IO Bool)
-> (SizeLimit -> IO (SizeLimit, Bool)) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \SizeLimit
a -> (SizeLimit, Bool) -> IO (SizeLimit, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((SizeLimit, Bool) -> IO (SizeLimit, Bool))
-> (SizeLimit, Bool) -> IO (SizeLimit, Bool)
forall a b. (a -> b) -> a -> b
$
if SizeLimit
a SizeLimit -> SizeLimit -> Bool
forall a. Ord a => a -> a -> Bool
> SizeLimit
0 then (SizeLimit
aSizeLimit -> SizeLimit -> SizeLimit
forall a. Num a => a -> a -> a
-SizeLimit
dec, Bool
True) else (SizeLimit
a, Bool
False)
if Bool
r then TimeoutHandle -> (TimeLimit -> IO a) -> IO a -> IO a
forall a. TimeoutHandle -> (TimeLimit -> IO a) -> IO a -> IO a
timeout TimeoutHandle
tb TimeLimit -> IO a
ta IO a
na else IO a
sa
decSizeBudget
:: Budget
-> (SizeLimit -> (SizeLimit, a))
-> IO a
decSizeBudget :: Budget -> (SizeLimit -> (SizeLimit, a)) -> IO a
decSizeBudget (Budget TimeoutHandle
_ MVar SizeLimit
sb) SizeLimit -> (SizeLimit, a)
f
= MVar SizeLimit -> (SizeLimit -> IO (SizeLimit, a)) -> IO a
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar SizeLimit
sb ((SizeLimit -> IO (SizeLimit, a)) -> IO a)
-> (SizeLimit -> IO (SizeLimit, a)) -> IO a
forall a b. (a -> b) -> a -> b
$ (SizeLimit, a) -> IO (SizeLimit, a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((SizeLimit, a) -> IO (SizeLimit, a))
-> (SizeLimit -> (SizeLimit, a)) -> SizeLimit -> IO (SizeLimit, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizeLimit -> (SizeLimit, a)
f
showTimeout :: Double -> String
showTimeout :: TimeLimit -> String
showTimeout TimeLimit
d
= String
"timeout at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SizeLimit -> String
forall a. Show a => a -> String
show (TimeLimit -> SizeLimit
forall a b. (RealFrac a, Integral b) => a -> b
round (TimeLimit -> SizeLimit) -> TimeLimit -> SizeLimit
forall a b. (a -> b) -> a -> b
$ TimeLimit
100 TimeLimit -> TimeLimit -> TimeLimit
forall a. Num a => a -> a -> a
* TimeLimit
d :: Int) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"%"