{-# LANGUAGE RecordWildCards, ViewPatterns #-}

module Development.Shake.Internal.Resource(
    Resource, newResourceIO, newThrottleIO, acquireResource, releaseResource
    ) where

import Data.Function
import System.IO.Unsafe
import Control.Concurrent.Extra
import Control.Exception.Extra
import Data.Tuple.Extra
import Control.Monad
import General.Bilist
import Development.Shake.Internal.Core.Pool
import System.Time.Extra
import Data.Monoid
import Prelude


{-# NOINLINE resourceIds #-}
resourceIds :: Var Int
resourceIds :: Var Int
resourceIds = IO (Var Int) -> Var Int
forall a. IO a -> a
unsafePerformIO (IO (Var Int) -> Var Int) -> IO (Var Int) -> Var Int
forall a b. (a -> b) -> a -> b
$ Int -> IO (Var Int)
forall a. a -> IO (Var a)
newVar 0

resourceId :: IO Int
resourceId :: IO Int
resourceId = Var Int -> (Int -> IO (Int, Int)) -> IO Int
forall a b. Var a -> (a -> IO (a, b)) -> IO b
modifyVar Var Int
resourceIds ((Int -> IO (Int, Int)) -> IO Int)
-> (Int -> IO (Int, Int)) -> IO Int
forall a b. (a -> b) -> a -> b
$ \i :: Int
i -> let j :: Int
j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 in Int
j Int -> IO (Int, Int) -> IO (Int, Int)
forall a b. a -> b -> b
`seq` (Int, Int) -> IO (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
j, Int
j)


-- | A type representing an external resource which the build system should respect. There
--   are two ways to create 'Resource's in Shake:
--
-- * 'Development.Shake.newResource' creates a finite resource, stopping too many actions running
--   simultaneously.
--
-- * 'Development.Shake.newThrottle' creates a throttled resource, stopping too many actions running
--   over a short time period.
--
--   These resources are used with 'Development.Shake.withResource' when defining rules. Typically only
--   system commands (such as 'Development.Shake.cmd') should be run inside 'Development.Shake.withResource',
--   not commands such as 'Development.Shake.need'.
--
--   Be careful that the actions run within 'Development.Shake.withResource' do not themselves require further
--   resources, or you may get a \"thread blocked indefinitely in an MVar operation\" exception.
--   If an action requires multiple resources, use 'Development.Shake.withResources' to avoid deadlock.
data Resource = Resource
    {Resource -> Int
resourceOrd :: Int
        -- ^ Key used for Eq/Ord operations. To make withResources work, we require newResourceIO < newThrottleIO
    ,Resource -> String
resourceShow :: String
        -- ^ String used for Show
    ,Resource -> Pool -> Int -> IO () -> IO ()
acquireResource :: Pool -> Int -> IO () -> IO ()
        -- ^ Acquire the resource and call the function.
    ,Resource -> Pool -> Int -> IO ()
releaseResource :: Pool -> Int -> IO ()
        -- ^ You should only ever releaseResource that you obtained with acquireResource.
    }

instance Show Resource where show :: Resource -> String
show = Resource -> String
resourceShow
instance Eq Resource where == :: Resource -> Resource -> Bool
(==) = Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> (Resource -> Int) -> Resource -> Resource -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Resource -> Int
resourceOrd
instance Ord Resource where compare :: Resource -> Resource -> Ordering
compare = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (Resource -> Int) -> Resource -> Resource -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Resource -> Int
resourceOrd


---------------------------------------------------------------------
-- FINITE RESOURCES

data Finite = Finite
    {Finite -> Int
finiteAvailable :: !Int
        -- ^ number of currently available resources
    ,Finite -> Bilist (Int, IO ())
finiteWaiting :: Bilist (Int, IO ())
        -- ^ queue of people with how much they want and the action when it is allocated to them
    }

-- | A version of 'Development.Shake.newResource' that runs in IO, and can be called before calling 'Development.Shake.shake'.
--   Most people should use 'Development.Shake.newResource' instead.
newResourceIO :: String -> Int -> IO Resource
newResourceIO :: String -> Int -> IO Resource
newResourceIO name :: String
name mx :: Int
mx = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
mx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
forall a. Partial => String -> IO a
errorIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "You cannot create a resource named " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ " with a negative quantity, you used " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
mx
    Int
key <- IO Int
resourceId
    Var Finite
var <- Finite -> IO (Var Finite)
forall a. a -> IO (Var a)
newVar (Finite -> IO (Var Finite)) -> Finite -> IO (Var Finite)
forall a b. (a -> b) -> a -> b
$ Int -> Bilist (Int, IO ()) -> Finite
Finite Int
mx Bilist (Int, IO ())
forall a. Monoid a => a
mempty
    Resource -> IO Resource
forall (m :: * -> *) a. Monad m => a -> m a
return (Resource -> IO Resource) -> Resource -> IO Resource
forall a b. (a -> b) -> a -> b
$ Int
-> String
-> (Pool -> Int -> IO () -> IO ())
-> (Pool -> Int -> IO ())
-> Resource
Resource (Int -> Int
forall a. Num a => a -> a
negate Int
key) String
shw (Var Finite -> Pool -> Int -> IO () -> IO ()
acquire Var Finite
var) (Var Finite -> Pool -> Int -> IO ()
release Var Finite
var)
    where
        shw :: String
shw = "Resource " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name

        acquire :: Var Finite -> Pool -> Int -> IO () -> IO ()
        acquire :: Var Finite -> Pool -> Int -> IO () -> IO ()
acquire var :: Var Finite
var pool :: Pool
pool want :: Int
want continue :: IO ()
continue
            | Int
want Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = String -> IO ()
forall a. Partial => String -> IO a
errorIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "You cannot acquire a negative quantity of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
shw String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", requested " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
want
            | Int
want Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = String -> IO ()
forall a. Partial => String -> IO a
errorIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "You cannot acquire more than " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
mx String -> ShowS
forall a. [a] -> [a] -> [a]
++ " of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
shw String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", requested " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
want
            | Bool
otherwise = IO (IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join  (IO (IO ()) -> IO ()) -> IO (IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Var Finite -> (Finite -> IO (Finite, IO ())) -> IO (IO ())
forall a b. Var a -> (a -> IO (a, b)) -> IO b
modifyVar Var Finite
var ((Finite -> IO (Finite, IO ())) -> IO (IO ()))
-> (Finite -> IO (Finite, IO ())) -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ \x :: Finite
x@Finite{..} -> (Finite, IO ()) -> IO (Finite, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Finite, IO ()) -> IO (Finite, IO ()))
-> (Finite, IO ()) -> IO (Finite, IO ())
forall a b. (a -> b) -> a -> b
$
                if Int
want Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
finiteAvailable then
                    (Finite
x{finiteAvailable :: Int
finiteAvailable = Int
finiteAvailable Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
want}, IO ()
continue)
                else
                    (Finite
x{finiteWaiting :: Bilist (Int, IO ())
finiteWaiting = Bilist (Int, IO ())
finiteWaiting Bilist (Int, IO ()) -> (Int, IO ()) -> Bilist (Int, IO ())
forall a. Bilist a -> a -> Bilist a
`snoc` (Int
want, Pool -> IO () -> IO ()
forall a. Pool -> IO a -> IO ()
addPoolResume Pool
pool IO ()
continue)}, () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

        release :: Var Finite -> Pool -> Int -> IO ()
        release :: Var Finite -> Pool -> Int -> IO ()
release var :: Var Finite
var _ i :: Int
i = IO (IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO ()) -> IO ()) -> IO (IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Var Finite -> (Finite -> IO (Finite, IO ())) -> IO (IO ())
forall a b. Var a -> (a -> IO (a, b)) -> IO b
modifyVar Var Finite
var ((Finite -> IO (Finite, IO ())) -> IO (IO ()))
-> (Finite -> IO (Finite, IO ())) -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ \x :: Finite
x -> (Finite, IO ()) -> IO (Finite, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Finite, IO ()) -> IO (Finite, IO ()))
-> (Finite, IO ()) -> IO (Finite, IO ())
forall a b. (a -> b) -> a -> b
$ Finite -> (Finite, IO ())
f Finite
x{finiteAvailable :: Int
finiteAvailable = Finite -> Int
finiteAvailable Finite
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i}
            where
                f :: Finite -> (Finite, IO ())
f (Finite i :: Int
i (Bilist (Int, IO ()) -> Maybe ((Int, IO ()), Bilist (Int, IO ()))
forall a. Bilist a -> Maybe (a, Bilist a)
uncons -> Just ((wi :: Int
wi,wa :: IO ()
wa),ws :: Bilist (Int, IO ())
ws)))
                    | Int
wi Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i = (IO () -> IO ()) -> (Finite, IO ()) -> (Finite, IO ())
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (IO ()
wa IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) ((Finite, IO ()) -> (Finite, IO ()))
-> (Finite, IO ()) -> (Finite, IO ())
forall a b. (a -> b) -> a -> b
$ Finite -> (Finite, IO ())
f (Finite -> (Finite, IO ())) -> Finite -> (Finite, IO ())
forall a b. (a -> b) -> a -> b
$ Int -> Bilist (Int, IO ()) -> Finite
Finite (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
wi) Bilist (Int, IO ())
ws
                    | Bool
otherwise = (Finite -> Finite) -> (Finite, IO ()) -> (Finite, IO ())
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first ((Int, IO ()) -> Finite -> Finite
add (Int
wi,IO ()
wa)) ((Finite, IO ()) -> (Finite, IO ()))
-> (Finite, IO ()) -> (Finite, IO ())
forall a b. (a -> b) -> a -> b
$ Finite -> (Finite, IO ())
f (Finite -> (Finite, IO ())) -> Finite -> (Finite, IO ())
forall a b. (a -> b) -> a -> b
$ Int -> Bilist (Int, IO ()) -> Finite
Finite Int
i Bilist (Int, IO ())
ws
                f (Finite i :: Int
i _) = (Int -> Bilist (Int, IO ()) -> Finite
Finite Int
i Bilist (Int, IO ())
forall a. Monoid a => a
mempty, () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                add :: (Int, IO ()) -> Finite -> Finite
add a :: (Int, IO ())
a s :: Finite
s = Finite
s{finiteWaiting :: Bilist (Int, IO ())
finiteWaiting = (Int, IO ())
a (Int, IO ()) -> Bilist (Int, IO ()) -> Bilist (Int, IO ())
forall a. a -> Bilist a -> Bilist a
`cons` Finite -> Bilist (Int, IO ())
finiteWaiting Finite
s}


---------------------------------------------------------------------
-- THROTTLE RESOURCES


-- call a function after a certain delay
waiter :: Seconds -> IO () -> IO ()
waiter :: Seconds -> IO () -> IO ()
waiter period :: Seconds
period act :: IO ()
act = IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    Seconds -> IO ()
sleep Seconds
period
    IO ()
act

-- Make sure the pool cannot run try until after you have finished with it
blockPool :: Pool -> IO (IO ())
blockPool :: Pool -> IO (IO ())
blockPool pool :: Pool
pool = do
    Barrier ()
bar <- IO (Barrier ())
forall a. IO (Barrier a)
newBarrier
    Pool -> IO () -> IO ()
forall a. Pool -> IO a -> IO ()
addPoolResume Pool
pool (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        IO ()
cancel <- Pool -> IO (IO ())
increasePool Pool
pool
        Barrier () -> IO ()
forall a. Barrier a -> IO a
waitBarrier Barrier ()
bar
        IO ()
cancel
    IO () -> IO (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> IO (IO ())) -> IO () -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ Barrier () -> () -> IO ()
forall a. Partial => Barrier a -> a -> IO ()
signalBarrier Barrier ()
bar ()


data Throttle
      -- | Some number of resources are available
    = ThrottleAvailable !Int
      -- | Some users are blocked (non-empty), plus an action to call once we go back to Available
    | ThrottleWaiting (IO ()) (Bilist (Int, IO ()))


-- | A version of 'Development.Shake.newThrottle' that runs in IO, and can be called before calling 'Development.Shake.shake'.
--   Most people should use 'Development.Shake.newThrottle' instead.
newThrottleIO :: String -> Int -> Double -> IO Resource
newThrottleIO :: String -> Int -> Seconds -> IO Resource
newThrottleIO name :: String
name count :: Int
count period :: Seconds
period = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
forall a. Partial => String -> IO a
errorIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "You cannot create a throttle named " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ " with a negative quantity, you used " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count
    Int
key <- IO Int
resourceId
    Var Throttle
var <- Throttle -> IO (Var Throttle)
forall a. a -> IO (Var a)
newVar (Throttle -> IO (Var Throttle)) -> Throttle -> IO (Var Throttle)
forall a b. (a -> b) -> a -> b
$ Int -> Throttle
ThrottleAvailable Int
count
    Resource -> IO Resource
forall (m :: * -> *) a. Monad m => a -> m a
return (Resource -> IO Resource) -> Resource -> IO Resource
forall a b. (a -> b) -> a -> b
$ Int
-> String
-> (Pool -> Int -> IO () -> IO ())
-> (Pool -> Int -> IO ())
-> Resource
Resource Int
key String
shw (Var Throttle -> Pool -> Int -> IO () -> IO ()
acquire Var Throttle
var) (Var Throttle -> Pool -> Int -> IO ()
release Var Throttle
var)
    where
        shw :: String
shw = "Throttle " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name

        acquire :: Var Throttle -> Pool -> Int -> IO () -> IO ()
        acquire :: Var Throttle -> Pool -> Int -> IO () -> IO ()
acquire var :: Var Throttle
var pool :: Pool
pool want :: Int
want continue :: IO ()
continue
            | Int
want Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = String -> IO ()
forall a. Partial => String -> IO a
errorIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "You cannot acquire a negative quantity of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
shw String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", requested " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
want
            | Int
want Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
count = String -> IO ()
forall a. Partial => String -> IO a
errorIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "You cannot acquire more than " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count String -> ShowS
forall a. [a] -> [a] -> [a]
++ " of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
shw String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", requested " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
want
            | Bool
otherwise = IO (IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO ()) -> IO ()) -> IO (IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Var Throttle -> (Throttle -> IO (Throttle, IO ())) -> IO (IO ())
forall a b. Var a -> (a -> IO (a, b)) -> IO b
modifyVar Var Throttle
var ((Throttle -> IO (Throttle, IO ())) -> IO (IO ()))
-> (Throttle -> IO (Throttle, IO ())) -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ \x :: Throttle
x -> case Throttle
x of
                ThrottleAvailable i :: Int
i
                    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
want -> (Throttle, IO ()) -> IO (Throttle, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Throttle
ThrottleAvailable (Int -> Throttle) -> Int -> Throttle
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
want, IO ()
continue)
                    | Bool
otherwise -> do
                        IO ()
stop <- Pool -> IO (IO ())
blockPool Pool
pool
                        (Throttle, IO ()) -> IO (Throttle, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> Bilist (Int, IO ()) -> Throttle
ThrottleWaiting IO ()
stop (Bilist (Int, IO ()) -> Throttle)
-> Bilist (Int, IO ()) -> Throttle
forall a b. (a -> b) -> a -> b
$ (Int
want Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i, Pool -> IO () -> IO ()
forall a. Pool -> IO a -> IO ()
addPoolResume Pool
pool IO ()
continue) (Int, IO ()) -> Bilist (Int, IO ()) -> Bilist (Int, IO ())
forall a. a -> Bilist a -> Bilist a
`cons` Bilist (Int, IO ())
forall a. Monoid a => a
mempty, () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                ThrottleWaiting stop :: IO ()
stop xs :: Bilist (Int, IO ())
xs -> (Throttle, IO ()) -> IO (Throttle, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> Bilist (Int, IO ()) -> Throttle
ThrottleWaiting IO ()
stop (Bilist (Int, IO ()) -> Throttle)
-> Bilist (Int, IO ()) -> Throttle
forall a b. (a -> b) -> a -> b
$ Bilist (Int, IO ())
xs Bilist (Int, IO ()) -> (Int, IO ()) -> Bilist (Int, IO ())
forall a. Bilist a -> a -> Bilist a
`snoc` (Int
want, Pool -> IO () -> IO ()
forall a. Pool -> IO a -> IO ()
addPoolResume Pool
pool IO ()
continue), () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

        release :: Var Throttle -> Pool -> Int -> IO ()
        release :: Var Throttle -> Pool -> Int -> IO ()
release var :: Var Throttle
var pool :: Pool
pool n :: Int
n = Seconds -> IO () -> IO ()
waiter Seconds
period (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO (IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO ()) -> IO ()) -> IO (IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Var Throttle -> (Throttle -> IO (Throttle, IO ())) -> IO (IO ())
forall a b. Var a -> (a -> IO (a, b)) -> IO b
modifyVar Var Throttle
var ((Throttle -> IO (Throttle, IO ())) -> IO (IO ()))
-> (Throttle -> IO (Throttle, IO ())) -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ \x :: Throttle
x -> (Throttle, IO ()) -> IO (Throttle, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Throttle, IO ()) -> IO (Throttle, IO ()))
-> (Throttle, IO ()) -> IO (Throttle, IO ())
forall a b. (a -> b) -> a -> b
$ case Throttle
x of
                ThrottleAvailable i :: Int
i -> (Int -> Throttle
ThrottleAvailable (Int -> Throttle) -> Int -> Throttle
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n, () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                ThrottleWaiting stop :: IO ()
stop xs :: Bilist (Int, IO ())
xs -> IO () -> Int -> Bilist (Int, IO ()) -> (Throttle, IO ())
f IO ()
stop Int
n Bilist (Int, IO ())
xs
            where
                f :: IO () -> Int -> Bilist (Int, IO ()) -> (Throttle, IO ())
f stop :: IO ()
stop i :: Int
i (Bilist (Int, IO ()) -> Maybe ((Int, IO ()), Bilist (Int, IO ()))
forall a. Bilist a -> Maybe (a, Bilist a)
uncons -> Just ((wi :: Int
wi,wa :: IO ()
wa),ws :: Bilist (Int, IO ())
ws))
                    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
wi = (IO () -> IO ()) -> (Throttle, IO ()) -> (Throttle, IO ())
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (IO ()
wa IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) ((Throttle, IO ()) -> (Throttle, IO ()))
-> (Throttle, IO ()) -> (Throttle, IO ())
forall a b. (a -> b) -> a -> b
$ IO () -> Int -> Bilist (Int, IO ()) -> (Throttle, IO ())
f IO ()
stop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
wi) Bilist (Int, IO ())
ws
                    | Bool
otherwise = (IO () -> Bilist (Int, IO ()) -> Throttle
ThrottleWaiting IO ()
stop (Bilist (Int, IO ()) -> Throttle)
-> Bilist (Int, IO ()) -> Throttle
forall a b. (a -> b) -> a -> b
$ (Int
wiInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i,IO ()
wa) (Int, IO ()) -> Bilist (Int, IO ()) -> Bilist (Int, IO ())
forall a. a -> Bilist a -> Bilist a
`cons` Bilist (Int, IO ())
ws, () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                f stop :: IO ()
stop i :: Int
i _ = (Int -> Throttle
ThrottleAvailable Int
i, IO ()
stop)