-- | 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 name mx = do
    when (mx < 0) $
        error $ "You cannot create a resource named " ++ name ++ " with a negative quantity, you used " ++ show mx
    key <- resourceId
    var <- newVar (mx, [])
    return $ Resource (negate key) shw (acquire var) (release var)
    where
        shw = "Resource " ++ name

        acquire :: Finite -> Int -> IO (Maybe (IO ()))
        acquire var want
            | want < 0 = error $ "You cannot acquire a negative quantity of " ++ shw ++ ", requested " ++ show want
            | want > mx = error $ "You cannot acquire more than " ++ show mx ++ " of " ++ shw ++ ", requested " ++ show want
            | otherwise = modifyVar var $ \(available,waiting) ->
                if want <= available then
                    return ((available - want, waiting), Nothing)
                else do
                    bar <- newBarrier
                    return ((available, waiting ++ [(want,bar)]), Just $ waitBarrier bar)

        release :: Finite -> Int -> IO ()
        release var i = modifyVar_ var $ \(available,waiting) -> f (available+i) waiting
            where
                f i ((wi,wa):ws) | wi <= i = signalBarrier wa () >> f (i-wi) ws
                                 | otherwise = do (i,ws) <- f i ws; return (i,(wi,wa):ws)
                f i [] = return (i, [])


---------------------------------------------------------------------
-- THROTTLE RESOURCES
newResourceIO :: String -> Int -> IO Resource
newResourceIO name mx = do
    when (mx < 0) $
        error $ "You cannot create a resource named " ++ name ++ " with a negative quantity, you used " ++ show mx
    key <- resourceId
    var <- newVar (mx, [])
    return $ Resource (negate key) shw (acquire var) (release var)
    where
        shw = "Resource " ++ name

        acquire :: Finite -> Int -> IO (Maybe (IO ()))
        acquire var want
            | want < 0 = error $ "You cannot acquire a negative quantity of " ++ shw ++ ", requested " ++ show want
            | want > mx = error $ "You cannot acquire more than " ++ show mx ++ " of " ++ shw ++ ", requested " ++ show want
            | otherwise = modifyVar var $ \(available,waiting) ->
                if want <= available then
                    return ((available - want, waiting), Nothing)
                else do
                    bar <- newBarrier
                    return ((available, waiting ++ [(want,bar)]), Just $ waitBarrier bar)

        release :: Finite -> Int -> IO ()
        release var i = modifyVar_ var $ \(available,waiting) -> f (available+i) waiting
            where
                f i ((wi,wa):ws) | wi <= i = signalBarrier wa () >> f (i-wi) ws
                                 | otherwise = do (i,ws) <- f i ws; return (i,(wi,wa):ws)
                f i [] = return (i, [])


---------------------------------------------------------------------
-- THROTTLE RESOURCES
newResourceIO name mx = do
    when (mx < 0) $
        error $ "You cannot create a resource named " ++ name ++ " with a negative quantity, you used " ++ show mx
    key <- resourceId
    var <- newVar (mx, [])
    return $ Resource (negate key) shw (acquire var) (release var)
    where
        shw = "Resource " ++ name

        acquire :: Finite -> Int -> IO (Maybe (IO ()))
        acquire var want
            | want < 0 = error $ "You cannot acquire a negative quantity of " ++ shw ++ ", requested " ++ show want
            | want > mx = error $ "You cannot acquire more than " ++ show mx ++ " of " ++ shw ++ ", requested " ++ show want
            | otherwise = modifyVar var $ \(available,waiting) ->
                if want <= available then
                    return ((available - want, waiting), Nothing)
                else do
                    bar <- newBarrier
                    return ((available, waiting ++ [(want,bar)]), Just $ waitBarrier bar)

        release :: Finite -> Int -> IO ()
        release var i = modifyVar_ var $ \(available,waiting) -> f (available+i) waiting
            where
                f i ((wi,wa):ws) | wi <= i = signalBarrier wa () >> f (i-wi) ws
                                 | otherwise = do (i,ws) <- f i ws; return (i,(wi,wa):ws)
                f i [] = return (i, [])


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