{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards, ViewPatterns #-}

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

import Data.Function
import System.IO.Unsafe
import Control.Concurrent.Extra
import General.Fence
import Control.Exception.Extra
import Data.Tuple.Extra
import Data.IORef
import Control.Monad.Extra
import General.Bilist
import General.Pool
import Development.Shake.Internal.Core.Action
import Development.Shake.Internal.Core.Types
import Development.Shake.Internal.Core.Monad
import Development.Shake.Internal.Core.Pool
import Control.Monad.IO.Class
import System.Time.Extra


{-# NOINLINE resourceId #-}
resourceId :: IO Int
resourceId :: IO Int
resourceId = forall a. IO a -> a
unsafePerformIO IO (IO Int)
resourceCounter

-- Work around for GHC bug https://gitlab.haskell.org/ghc/ghc/-/issues/19413
{-# NOINLINE  resourceCounter #-}
resourceCounter :: IO (IO Int)
resourceCounter :: IO (IO Int)
resourceCounter = do
    IORef Int
ref <- forall a. a -> IO (IORef a)
newIORef Int
0
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Int
ref forall a b. (a -> b) -> a -> b
$ \Int
i -> let j :: Int
j = Int
i forall a. Num a => a -> a -> a
+ Int
1 in (Int
j, Int
j)


-- | Run an action which uses part of a finite resource. For more details see 'Resource'.
--   You cannot depend on a rule (e.g. 'need') while a resource is held.
withResource :: Resource -> Int -> Action a -> Action a
withResource :: forall a. Resource -> Int -> Action a -> Action a
withResource Resource
r Int
i Action a
act = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOptions :: Global -> ShakeOptions
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw ro
getRO
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO String -> IO ()
globalDiagnostic forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Resource
r forall a. [a] -> [a] -> [a]
++ String
" waiting to acquire " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i

    Maybe (Fence IO ())
fence <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Resource -> Pool -> Int -> IO (Maybe (Fence IO ()))
acquireResource Resource
r Pool
globalPool Int
i
    forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (Fence IO ())
fence forall a b. (a -> b) -> a -> b
$ \Fence IO ()
fence -> do
        (Seconds
offset, ()) <- forall a b.
(a -> Either SomeException b) -> Fence IO a -> Action (Seconds, b)
actionFenceRequeueBy forall a b. b -> Either a b
Right Fence IO ()
fence
        forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW forall a b. (a -> b) -> a -> b
$ Seconds -> Local -> Local
addDiscount Seconds
offset

    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO String -> IO ()
globalDiagnostic forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Resource
r forall a. [a] -> [a] -> [a]
++ String
" running with " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i
    forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction (forall a. String -> Action a -> Action a
blockApply (String
"Within withResource using " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Resource
r) Action a
act) forall k v ro rw a b.
RAW k v ro rw a -> RAW k v ro rw b -> RAW k v ro rw a
`finallyRAW` do
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Resource -> Pool -> Int -> IO ()
releaseResource Resource
r Pool
globalPool Int
i
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO String -> IO ()
globalDiagnostic forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Resource
r forall a. [a] -> [a] -> [a]
++ String
" released " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i



-- | 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 (Maybe (Fence IO ()))
acquireResource :: Pool -> Int -> IO (Maybe (Fence 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
(==) = forall a. Eq a => a -> a -> 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 = forall a. Ord a => a -> a -> Ordering
compare 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, Fence IO ())
finiteWaiting :: Bilist (Int, Fence 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 String
name Int
mx = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
mx forall a. Ord a => a -> a -> Bool
< Int
0) forall a b. (a -> b) -> a -> b
$
        forall a. Partial => String -> IO a
errorIO forall a b. (a -> b) -> a -> b
$ String
"You cannot create a resource named " forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
" with a negative quantity, you used " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
mx
    Int
key <- IO Int
resourceId
    Var Finite
var <- forall a. a -> IO (Var a)
newVar forall a b. (a -> b) -> a -> b
$ Int -> Bilist (Int, Fence IO ()) -> Finite
Finite Int
mx forall a. Monoid a => a
mempty
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int
-> String
-> (Pool -> Int -> IO (Maybe (Fence IO ())))
-> (Pool -> Int -> IO ())
-> Resource
Resource (forall a. Num a => a -> a
negate Int
key) String
shw (Var Finite -> Pool -> Int -> IO (Maybe (Fence IO ()))
acquire Var Finite
var) (Var Finite -> Pool -> Int -> IO ()
release Var Finite
var)
    where
        shw :: String
shw = String
"Resource " forall a. [a] -> [a] -> [a]
++ String
name

        acquire :: Var Finite -> Pool -> Int -> IO (Maybe (Fence IO ()))
        acquire :: Var Finite -> Pool -> Int -> IO (Maybe (Fence IO ()))
acquire Var Finite
var Pool
_ Int
want
            | Int
want forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. Partial => String -> IO a
errorIO forall a b. (a -> b) -> a -> b
$ String
"You cannot acquire a negative quantity of " forall a. [a] -> [a] -> [a]
++ String
shw forall a. [a] -> [a] -> [a]
++ String
", requested " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
want
            | Int
want forall a. Ord a => a -> a -> Bool
> Int
mx = forall a. Partial => String -> IO a
errorIO forall a b. (a -> b) -> a -> b
$ String
"You cannot acquire more than " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
mx forall a. [a] -> [a] -> [a]
++ String
" of " forall a. [a] -> [a] -> [a]
++ String
shw forall a. [a] -> [a] -> [a]
++ String
", requested " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
want
            | Bool
otherwise = forall a b. Var a -> (a -> IO (a, b)) -> IO b
modifyVar Var Finite
var forall a b. (a -> b) -> a -> b
$ \x :: Finite
x@Finite{Int
Bilist (Int, Fence IO ())
finiteWaiting :: Bilist (Int, Fence IO ())
finiteAvailable :: Int
finiteWaiting :: Finite -> Bilist (Int, Fence IO ())
finiteAvailable :: Finite -> Int
..} ->
                if Int
want forall a. Ord a => a -> a -> Bool
<= Int
finiteAvailable then
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Finite
x{finiteAvailable :: Int
finiteAvailable = Int
finiteAvailable forall a. Num a => a -> a -> a
- Int
want}, forall a. Maybe a
Nothing)
                else do
                    Fence IO ()
fence <- forall (m :: * -> *) a. MonadIO m => IO (Fence m a)
newFence
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Finite
x{finiteWaiting :: Bilist (Int, Fence IO ())
finiteWaiting = Bilist (Int, Fence IO ())
finiteWaiting forall a. Bilist a -> a -> Bilist a
`snoc` (Int
want, Fence IO ()
fence)}, forall a. a -> Maybe a
Just Fence IO ()
fence)

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


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


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


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, Fence 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 String
name Int
count Seconds
period = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count forall a. Ord a => a -> a -> Bool
< Int
0) forall a b. (a -> b) -> a -> b
$
        forall a. Partial => String -> IO a
errorIO forall a b. (a -> b) -> a -> b
$ String
"You cannot create a throttle named " forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
" with a negative quantity, you used " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
count
    Int
key <- IO Int
resourceId
    Var Throttle
var <- forall a. a -> IO (Var a)
newVar forall a b. (a -> b) -> a -> b
$ Int -> Throttle
ThrottleAvailable Int
count
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int
-> String
-> (Pool -> Int -> IO (Maybe (Fence IO ())))
-> (Pool -> Int -> IO ())
-> Resource
Resource Int
key String
shw (Var Throttle -> Pool -> Int -> IO (Maybe (Fence IO ()))
acquire Var Throttle
var) (Var Throttle -> Pool -> Int -> IO ()
release Var Throttle
var)
    where
        shw :: String
shw = String
"Throttle " forall a. [a] -> [a] -> [a]
++ String
name

        acquire :: Var Throttle -> Pool -> Int -> IO (Maybe (Fence IO ()))
        acquire :: Var Throttle -> Pool -> Int -> IO (Maybe (Fence IO ()))
acquire Var Throttle
var Pool
pool Int
want
            | Int
want forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. Partial => String -> IO a
errorIO forall a b. (a -> b) -> a -> b
$ String
"You cannot acquire a negative quantity of " forall a. [a] -> [a] -> [a]
++ String
shw forall a. [a] -> [a] -> [a]
++ String
", requested " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
want
            | Int
want forall a. Ord a => a -> a -> Bool
> Int
count = forall a. Partial => String -> IO a
errorIO forall a b. (a -> b) -> a -> b
$ String
"You cannot acquire more than " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
count forall a. [a] -> [a] -> [a]
++ String
" of " forall a. [a] -> [a] -> [a]
++ String
shw forall a. [a] -> [a] -> [a]
++ String
", requested " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
want
            | Bool
otherwise = forall a b. Var a -> (a -> IO (a, b)) -> IO b
modifyVar Var Throttle
var forall a b. (a -> b) -> a -> b
$ \case
                ThrottleAvailable Int
i
                    | Int
i forall a. Ord a => a -> a -> Bool
>= Int
want -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Throttle
ThrottleAvailable forall a b. (a -> b) -> a -> b
$ Int
i forall a. Num a => a -> a -> a
- Int
want, forall a. Maybe a
Nothing)
                    | Bool
otherwise -> do
                        IO ()
stop <- Pool -> IO (IO ())
keepAlivePool Pool
pool
                        Fence IO ()
fence <- forall (m :: * -> *) a. MonadIO m => IO (Fence m a)
newFence
                        forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO () -> Bilist (Int, Fence IO ()) -> Throttle
ThrottleWaiting IO ()
stop forall a b. (a -> b) -> a -> b
$ (Int
want forall a. Num a => a -> a -> a
- Int
i, Fence IO ()
fence) forall a. a -> Bilist a -> Bilist a
`cons` forall a. Monoid a => a
mempty, forall a. a -> Maybe a
Just Fence IO ()
fence)
                ThrottleWaiting IO ()
stop Bilist (Int, Fence IO ())
xs -> do
                    Fence IO ()
fence <- forall (m :: * -> *) a. MonadIO m => IO (Fence m a)
newFence
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO () -> Bilist (Int, Fence IO ()) -> Throttle
ThrottleWaiting IO ()
stop forall a b. (a -> b) -> a -> b
$ Bilist (Int, Fence IO ())
xs forall a. Bilist a -> a -> Bilist a
`snoc` (Int
want, Fence IO ()
fence), forall a. a -> Maybe a
Just Fence IO ()
fence)

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