1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
-- |Time and size limits
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)
--------------
-- |Time limit is a 'Double' which is the allowed time in seconds.
type TimeLimit = Double
-- |Size limit is an 'Int' which meaning is given by 'checkBudget' and 'decSizeBudget'.
type SizeLimit = Int
-- |A 'Budget' contains a time and size limit.
data Budget
= Budget TimeoutHandle (MVar SizeLimit)
-- |Create a new budget.
newBudget :: TimeLimit -> SizeLimit -> IO Budget
newBudget t s = do
th <- timeoutHandle t
mv <- newMVar s
return $ Budget th mv
-- |Check budget and take another action if there is no more resource.
checkBudget
:: Budget
-> Int -- ^ decrement size budget with this value
-> (Double -> IO a) -- ^ what to do in case of timeout ('Double': percent when the thread was started)
-> IO a -- ^ what to do in case there is no more space
-> IO a -- ^ what to do in a normal case
-> IO a
checkBudget (Budget tb sb) dec ta sa na = do
r <- modifyMVar sb $ \a -> return $
if a > 0 then (a-dec, True) else (a, False)
if r then timeout tb ta na else sa
-- |Decrement free size in a budget.
decSizeBudget
:: Budget
-> (SizeLimit -> (SizeLimit, a)) -- ^ funtion to modify free size and produce a value
-> IO a
decSizeBudget (Budget _ sb) f
= modifyMVar sb $ return . f
showTimeout :: Double -> String
showTimeout d
= "timeout at " ++ show (round $ 100 * d :: Int) ++ "%"
|
