-- |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 :: 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

-- |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 -> 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

-- |Decrement free size in a budget.
decSizeBudget 
    :: Budget
    -> (SizeLimit -> (SizeLimit, a))    -- ^ funtion to modify free size and produce a value
    -> 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
"%"