    {-# 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 = IO (IO Int) -> IO Int
    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 <- Int -> IO (IORef Int)
    forall a. a -> IO (IORef a)
    newIORef Int
    0
        IO Int -> IO (IO Int)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (IO Int -> IO (IO Int)) -> IO Int -> IO (IO Int)
    forall a b. (a -> b) -> a -> b
    $ IORef Int -> (Int -> (Int, Int)) -> IO Int
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef Int
    ref ((Int -> (Int, Int)) -> IO Int) -> (Int -> (Int, Int)) -> IO Int
    forall a b. (a -> b) -> a -> b
    $ \Int
    i -> let j :: Int
    j = Int
    i Int -> Int -> Int
    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 ()
    globalBuild :: [String] -> [Key] -> Action [Value]
    globalDatabase :: Database
    globalPool :: Pool
    globalCleanup :: Cleanup
    globalTimestamp :: IO Seconds
    globalRules :: HashMap TypeRep BuiltinRule
    globalOutput :: Verbosity -> String -> IO ()
    globalOptions :: ShakeOptions
    globalDiagnostic :: IO String -> IO ()
    globalRuleFinished :: Key -> Action ()
    globalAfter :: IORef [IO ()]
    globalTrackAbsent :: IORef [(Key, Key)]
    globalProgress :: IO Progress
    globalUserRules :: Map UserRuleVersioned
    globalShared :: Maybe Shared
    globalCloud :: Maybe Cloud
    globalStep :: Step
    globalOneShot :: Bool
    globalBuild :: Global -> [String] -> [Key] -> Action [Value]
    globalDatabase :: Global -> Database
    globalPool :: Global -> Pool
    globalCleanup :: Global -> Cleanup
    globalTimestamp :: Global -> IO Seconds
    globalRules :: Global -> HashMap TypeRep BuiltinRule
    globalOutput :: Global -> Verbosity -> String -> IO ()
    globalOptions :: Global -> ShakeOptions
    globalDiagnostic :: Global -> IO String -> IO ()
    globalRuleFinished :: Global -> Key -> Action ()
    globalAfter :: Global -> IORef [IO ()]
    globalTrackAbsent :: Global -> IORef [(Key, Key)]
    globalProgress :: Global -> IO Progress
    globalUserRules :: Global -> Map UserRuleVersioned
    globalShared :: Global -> Maybe Shared
    globalCloud :: Global -> Maybe Cloud
    globalStep :: Global -> Step
    globalOneShot :: Global -> Bool
    ..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
    forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
    Action RAW ([String], [Key]) [Value] Global Local Global
    forall k v ro rw. RAW k v ro rw ro
    getRO
        IO () -> Action ()
    forall a. IO a -> Action a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Action ()) -> IO () -> Action ()
    forall a b. (a -> b) -> a -> b
    $ IO String -> IO ()
    globalDiagnostic (IO String -> IO ()) -> IO String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO String
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ Resource -> String
    forall a. Show a => a -> String
    show Resource
    r String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " waiting to acquire " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    i

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

        IO () -> Action ()
    forall a. IO a -> Action a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Action ()) -> IO () -> Action ()
    forall a b. (a -> b) -> a -> b
    $ IO String -> IO ()
    globalDiagnostic (IO String -> IO ()) -> IO String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO String
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ Resource -> String
    forall a. Show a => a -> String
    show Resource
    r String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " running with " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    i
        RAW ([String], [Key]) [Value] Global Local a -> Action a
    forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
    Action (RAW ([String], [Key]) [Value] Global Local a -> Action a)
    -> RAW ([String], [Key]) [Value] Global Local a -> Action a
    forall a b. (a -> b) -> a -> b
    $ Action a -> RAW ([String], [Key]) [Value] Global Local a
    forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
    fromAction (String -> Action a -> Action a
    forall a. String -> Action a -> Action a
    blockApply (String
    "Within withResource using " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Resource -> String
    forall a. Show a => a -> String
    show Resource
    r) Action a
    act) RAW ([String], [Key]) [Value] Global Local a
    -> RAW ([String], [Key]) [Value] Global Local ()
    -> RAW ([String], [Key]) [Value] Global Local a
    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
            IO () -> RAW ([String], [Key]) [Value] Global Local ()
    forall a. IO a -> RAW ([String], [Key]) [Value] Global Local a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> RAW ([String], [Key]) [Value] Global Local ())
    -> IO () -> RAW ([String], [Key]) [Value] Global Local ()
    forall a b. (a -> b) -> a -> b
    $ Resource -> Pool -> Int -> IO ()
    releaseResource Resource
    r Pool
    globalPool Int
    i
            IO () -> RAW ([String], [Key]) [Value] Global Local ()
    forall a. IO a -> RAW ([String], [Key]) [Value] Global Local a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> RAW ([String], [Key]) [Value] Global Local ())
    -> IO () -> RAW ([String], [Key]) [Value] Global Local ()
    forall a b. (a -> b) -> a -> b
    $ IO String -> IO ()
    globalDiagnostic (IO String -> IO ()) -> IO String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO String
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ Resource -> String
    forall a. Show a => a -> String
    show Resource
    r String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " released " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    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
    (==) = 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, 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
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    mx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    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
    $ String
    "You cannot create a resource named " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " with a negative quantity, you used " String -> String -> String
    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, Fence IO ()) -> Finite
    Finite Int
    mx Bilist (Int, Fence IO ())
    forall a. Monoid a => a
    mempty
        Resource -> IO Resource
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Resource -> IO Resource) -> Resource -> IO Resource
    forall a b. (a -> b) -> a -> b
    $ Int
    -> String
    -> (Pool -> Int -> IO (Maybe (Fence IO ())))
    -> (Pool -> Int -> IO ())
    -> Resource
    Resource (Int -> Int
    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 " String -> String -> String
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 = String -> IO (Maybe (Fence IO ()))
    forall a. Partial => String -> IO a
    errorIO (String -> IO (Maybe (Fence IO ())))
    -> String -> IO (Maybe (Fence IO ()))
    forall a b. (a -> b) -> a -> b
    $ String
    "You cannot acquire a negative quantity of " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    shw String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", requested " String -> String -> String
    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 (Maybe (Fence IO ()))
    forall a. Partial => String -> IO a
    errorIO (String -> IO (Maybe (Fence IO ())))
    -> String -> IO (Maybe (Fence IO ()))
    forall a b. (a -> b) -> a -> b
    $ String
    "You cannot acquire more than " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    mx String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " of " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    shw String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", requested " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    want
                | Bool
    otherwise = Var Finite
    -> (Finite -> IO (Finite, Maybe (Fence IO ())))
    -> IO (Maybe (Fence IO ()))
    forall a b. Var a -> (a -> IO (a, b)) -> IO b
    modifyVar Var Finite
    var ((Finite -> IO (Finite, Maybe (Fence IO ())))
     -> IO (Maybe (Fence IO ())))
    -> (Finite -> IO (Finite, Maybe (Fence IO ())))
    -> IO (Maybe (Fence IO ()))
    forall a b. (a -> b) -> a -> b
    $ \x :: Finite
    x@Finite{Int
    Bilist (Int, Fence IO ())
    finiteAvailable :: Finite -> Int
    finiteWaiting :: Finite -> Bilist (Int, Fence IO ())
    finiteAvailable :: Int
    finiteWaiting :: Bilist (Int, Fence IO ())
    ..} ->
                    if Int
    want Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    finiteAvailable then
                        (Finite, Maybe (Fence IO ())) -> IO (Finite, Maybe (Fence IO ()))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Finite
    x{finiteAvailable :: Int
    finiteAvailable = Int
    finiteAvailable Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    want}, Maybe (Fence IO ())
    forall a. Maybe a
    Nothing)
                    else do
                        Fence IO ()
    fence <- IO (Fence IO ())
    forall (m :: * -> *) a. MonadIO m => IO (Fence m a)
    newFence
                        (Finite, Maybe (Fence IO ())) -> IO (Finite, Maybe (Fence IO ()))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Finite
    x{finiteWaiting :: Bilist (Int, Fence IO ())
    finiteWaiting = Bilist (Int, Fence IO ())
    finiteWaiting Bilist (Int, Fence IO ())
    -> (Int, Fence IO ()) -> Bilist (Int, Fence IO ())
    forall a. Bilist a -> a -> Bilist a
    `snoc` (Int
    want, Fence IO ()
    fence)}, Fence IO () -> Maybe (Fence IO ())
    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 = 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
    $ \Finite
    x -> (Finite, IO ()) -> IO (Finite, IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((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 Int
    i (Bilist (Int, Fence IO ())
    -> Maybe ((Int, Fence IO ()), Bilist (Int, Fence IO ()))
    forall a. Bilist a -> Maybe (a, Bilist a)
    uncons -> Just ((Int
    wi,Fence IO ()
    wa),Bilist (Int, Fence 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 (Fence IO () -> () -> IO ()
    forall (m :: * -> *) a.
    (Partial, MonadIO m) =>
    Fence m a -> a -> m ()
    signalFence Fence IO ()
    wa () IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    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, Fence IO ()) -> Finite
    Finite (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    wi) Bilist (Int, Fence IO ())
    ws
                        | Bool
    otherwise = (Finite -> Finite) -> (Finite, IO ()) -> (Finite, IO ())
    forall a a' b. (a -> a') -> (a, b) -> (a', b)
    first ((Int, Fence IO ()) -> Finite -> Finite
    add (Int
    wi,Fence 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, 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 Bilist (Int, Fence IO ())
    forall a. Monoid a => a
    mempty, () -> IO ()
    forall a. a -> IO a
    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 (Int, Fence IO ())
    -> Bilist (Int, Fence IO ()) -> Bilist (Int, Fence IO ())
    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 = 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

    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
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    count Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    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
    $ String
    "You cannot create a throttle named " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " with a negative quantity, you used " String -> String -> String
    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 a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Resource -> IO Resource) -> Resource -> IO Resource
    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 " String -> String -> String
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 = String -> IO (Maybe (Fence IO ()))
    forall a. Partial => String -> IO a
    errorIO (String -> IO (Maybe (Fence IO ())))
    -> String -> IO (Maybe (Fence IO ()))
    forall a b. (a -> b) -> a -> b
    $ String
    "You cannot acquire a negative quantity of " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    shw String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", requested " String -> String -> String
    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 (Maybe (Fence IO ()))
    forall a. Partial => String -> IO a
    errorIO (String -> IO (Maybe (Fence IO ())))
    -> String -> IO (Maybe (Fence IO ()))
    forall a b. (a -> b) -> a -> b
    $ String
    "You cannot acquire more than " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    count String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " of " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    shw String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", requested " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    want
                | Bool
    otherwise = Var Throttle
    -> (Throttle -> IO (Throttle, Maybe (Fence IO ())))
    -> IO (Maybe (Fence IO ()))
    forall a b. Var a -> (a -> IO (a, b)) -> IO b
    modifyVar Var Throttle
    var ((Throttle -> IO (Throttle, Maybe (Fence IO ())))
     -> IO (Maybe (Fence IO ())))
    -> (Throttle -> IO (Throttle, Maybe (Fence IO ())))
    -> IO (Maybe (Fence IO ()))
    forall a b. (a -> b) -> a -> b
    $ \case
                    ThrottleAvailable Int
    i
                        | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    want -> (Throttle, Maybe (Fence IO ()))
    -> IO (Throttle, Maybe (Fence IO ()))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (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, Maybe (Fence IO ())
    forall a. Maybe a
    Nothing)
                        | Bool
    otherwise -> do
                            IO ()
    stop <- Pool -> IO (IO ())
    keepAlivePool Pool
    pool
                            Fence IO ()
    fence <- IO (Fence IO ())
    forall (m :: * -> *) a. MonadIO m => IO (Fence m a)
    newFence
                            (Throttle, Maybe (Fence IO ()))
    -> IO (Throttle, Maybe (Fence IO ()))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (IO () -> Bilist (Int, Fence IO ()) -> Throttle
    ThrottleWaiting IO ()
    stop (Bilist (Int, Fence IO ()) -> Throttle)
    -> Bilist (Int, Fence IO ()) -> Throttle
    forall a b. (a -> b) -> a -> b
    $ (Int
    want Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    i, Fence IO ()
    fence) (Int, Fence IO ())
    -> Bilist (Int, Fence IO ()) -> Bilist (Int, Fence IO ())
    forall a. a -> Bilist a -> Bilist a
    `cons` Bilist (Int, Fence IO ())
    forall a. Monoid a => a
    mempty, Fence IO () -> Maybe (Fence IO ())
    forall a. a -> Maybe a
    Just Fence IO ()
    fence)
                    ThrottleWaiting IO ()
    stop Bilist (Int, Fence IO ())
    xs -> do
                        Fence IO ()
    fence <- IO (Fence IO ())
    forall (m :: * -> *) a. MonadIO m => IO (Fence m a)
    newFence
                        (Throttle, Maybe (Fence IO ()))
    -> IO (Throttle, Maybe (Fence IO ()))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (IO () -> Bilist (Int, Fence IO ()) -> Throttle
    ThrottleWaiting IO ()
    stop (Bilist (Int, Fence IO ()) -> Throttle)
    -> Bilist (Int, Fence IO ()) -> Throttle
    forall a b. (a -> b) -> a -> b
    $ Bilist (Int, Fence IO ())
    xs Bilist (Int, Fence IO ())
    -> (Int, Fence IO ()) -> Bilist (Int, Fence IO ())
    forall a. Bilist a -> a -> Bilist a
    `snoc` (Int
    want, Fence IO ()
    fence), Fence IO () -> Maybe (Fence IO ())
    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 (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
    $ \Throttle
    x -> (Throttle, IO ()) -> IO (Throttle, IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((Throttle, IO ()) -> IO (Throttle, IO ()))
    -> (Throttle, IO ()) -> IO (Throttle, IO ())
    forall a b. (a -> b) -> a -> b
    $ case Throttle
    x of
                    ThrottleAvailable 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 a. a -> IO a
    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 (Bilist (Int, Fence IO ())
    -> Maybe ((Int, Fence IO ()), Bilist (Int, Fence IO ()))
    forall a. Bilist a -> Maybe (a, Bilist a)
    uncons -> Just ((Int
    wi,Fence IO ()
    wa),Bilist (Int, Fence 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 (Fence IO () -> () -> IO ()
    forall (m :: * -> *) a.
    (Partial, MonadIO m) =>
    Fence m a -> a -> m ()
    signalFence Fence IO ()
    wa () IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    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, Fence IO ()) -> (Throttle, IO ())
    f IO ()
    stop (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    wi) Bilist (Int, Fence IO ())
    ws
                        | Bool
    otherwise = (IO () -> Bilist (Int, Fence IO ()) -> Throttle
    ThrottleWaiting IO ()
    stop (Bilist (Int, Fence IO ()) -> Throttle)
    -> Bilist (Int, Fence IO ()) -> Throttle
    forall a b. (a -> b) -> a -> b
    $ (Int
    wiInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    i,Fence IO ()
    wa) (Int, Fence IO ())
    -> Bilist (Int, Fence IO ()) -> Bilist (Int, Fence IO ())
    forall a. a -> Bilist a -> Bilist a
    `cons` Bilist (Int, Fence IO ())
    ws, () -> IO ()
    forall a. a -> IO a
    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)