{-# LANGUAGE RecordWildCards, TupleSections #-}

module Development.Shake.Internal.Core.Pool(
    addPoolWait, actionFenceSteal, actionFenceRequeue,
    actionAlwaysRequeue, actionAlwaysRequeuePriority,
    addPoolWait_,
    actionFenceRequeueBy
    ) where

import Control.Exception
import General.Pool
import Development.Shake.Internal.Core.Types
import Development.Shake.Internal.Core.Monad
import System.Time.Extra
import Data.Either.Extra
import Control.Monad.IO.Class
import General.Fence


priority :: Either a b -> PoolPriority
priority Either a b
x = if forall a b. Either a b -> Bool
isLeft Either a b
x then PoolPriority
PoolException else PoolPriority
PoolResume


-- | Enqueue an Action into the pool and return a Fence to wait for it.
--   Returns the value along with how long it spent executing.
addPoolWait :: PoolPriority -> Action a -> Action (Fence IO (Either SomeException (Seconds, a)))
addPoolWait :: forall a.
PoolPriority
-> Action a
-> Action (Fence IO (Either SomeException (Seconds, a)))
addPoolWait PoolPriority
pri Action a
act = do
    ro :: Global
ro@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
    Local
rw <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw rw
getRW
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        Fence IO (Either SomeException (Seconds, a))
fence <- forall (m :: * -> *) a. MonadIO m => IO (Fence m a)
newFence
        let act2 :: Action (Seconds, a)
act2 = do IO Seconds
offset <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (IO Seconds)
offsetTime; a
res <- Action a
act; Seconds
offset <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Seconds
offset; forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seconds
offset, a
res)
        forall a. PoolPriority -> Pool -> IO a -> IO ()
addPool PoolPriority
pri Pool
globalPool forall a b. (a -> b) -> a -> b
$ forall a.
Global -> Local -> Action a -> Capture (Either SomeException a)
runAction Global
ro Local
rw Action (Seconds, a)
act2 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(Partial, MonadIO m) =>
Fence m a -> a -> m ()
signalFence Fence IO (Either SomeException (Seconds, a))
fence
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Fence IO (Either SomeException (Seconds, a))
fence

-- | Like 'addPoolWait' but doesn't provide a fence to wait for it - a fire and forget version.
--   Warning: If Action throws an exception, it would be lost, so must be executed with try. Seconds are not tracked.
addPoolWait_ :: PoolPriority -> Action a -> Action ()
addPoolWait_ :: forall a. PoolPriority -> Action a -> Action ()
addPoolWait_ PoolPriority
pri Action a
act = do
    ro :: Global
ro@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 :: 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]
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]
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw ro
getRO
    Local
rw <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw rw
getRW
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PoolPriority -> Pool -> IO a -> IO ()
addPool PoolPriority
pri Pool
globalPool forall a b. (a -> b) -> a -> b
$ forall a.
Global -> Local -> Action a -> Capture (Either SomeException a)
runAction Global
ro Local
rw Action a
act forall a b. (a -> b) -> a -> b
$ \Either SomeException a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


actionFenceSteal :: Fence IO (Either SomeException a) -> Action (Seconds, a)
actionFenceSteal :: forall a. Fence IO (Either SomeException a) -> Action (Seconds, a)
actionFenceSteal Fence IO (Either SomeException a)
fence = do
    Maybe (Either SomeException a)
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Fence m a -> IO (Maybe a)
testFence Fence IO (Either SomeException a)
fence
    case Maybe (Either SomeException a)
res of
        Just (Left SomeException
e) -> forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall e k v ro rw a. Exception e => e -> RAW k v ro rw a
throwRAW SomeException
e
        Just (Right a
v) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seconds
0, a
v)
        Maybe (Either SomeException a)
Nothing -> forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall a k v ro rw.
Capture (Either SomeException a) -> RAW k v ro rw a
captureRAW forall a b. (a -> b) -> a -> b
$ \Either SomeException (Seconds, a) -> IO ()
continue -> do
            IO Seconds
offset <- IO (IO Seconds)
offsetTime
            forall (m :: * -> *) a.
MonadIO m =>
Fence m a -> (a -> m ()) -> m ()
waitFence Fence IO (Either SomeException a)
fence forall a b. (a -> b) -> a -> b
$ \Either SomeException a
v -> do
                Seconds
offset <- IO Seconds
offset
                Either SomeException (Seconds, a) -> IO ()
continue forall a b. (a -> b) -> a -> b
$ (Seconds
offset,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either SomeException a
v


actionFenceRequeue :: Fence IO (Either SomeException b) -> Action (Seconds, b)
actionFenceRequeue :: forall a. Fence IO (Either SomeException a) -> Action (Seconds, a)
actionFenceRequeue = forall a b.
(a -> Either SomeException b) -> Fence IO a -> Action (Seconds, b)
actionFenceRequeueBy forall a. a -> a
id

actionFenceRequeueBy :: (a -> Either SomeException b) -> Fence IO a -> Action (Seconds, b)
actionFenceRequeueBy :: forall a b.
(a -> Either SomeException b) -> Fence IO a -> Action (Seconds, b)
actionFenceRequeueBy a -> Either SomeException b
op Fence IO a
fence = forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ do
    Maybe a
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Fence m a -> IO (Maybe a)
testFence Fence IO a
fence
    case forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either SomeException b
op Maybe a
res of
        Just (Left SomeException
e) -> forall e k v ro rw a. Exception e => e -> RAW k v ro rw a
throwRAW SomeException
e
        Just (Right b
v) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seconds
0, b
v)
        Maybe (Either SomeException b)
Nothing -> 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 :: 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]
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]
..} <- forall k v ro rw. RAW k v ro rw ro
getRO
            IO Seconds
offset <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (IO Seconds)
offsetTime
            forall a k v ro rw.
Capture (Either SomeException a) -> RAW k v ro rw a
captureRAW forall a b. (a -> b) -> a -> b
$ \Either SomeException (Seconds, b) -> IO ()
continue -> forall (m :: * -> *) a.
MonadIO m =>
Fence m a -> (a -> m ()) -> m ()
waitFence Fence IO a
fence forall a b. (a -> b) -> a -> b
$ \a
v -> do
                let v2 :: Either SomeException b
v2 = a -> Either SomeException b
op a
v
                forall a. PoolPriority -> Pool -> IO a -> IO ()
addPool (forall {a} {b}. Either a b -> PoolPriority
priority Either SomeException b
v2) Pool
globalPool forall a b. (a -> b) -> a -> b
$ do
                    Seconds
offset <- IO Seconds
offset
                    Either SomeException (Seconds, b) -> IO ()
continue forall a b. (a -> b) -> a -> b
$ (Seconds
offset,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either SomeException b
v2


actionAlwaysRequeue :: Either SomeException a -> Action (Seconds, a)
actionAlwaysRequeue :: forall a. Either SomeException a -> Action (Seconds, a)
actionAlwaysRequeue Either SomeException a
res = forall a.
PoolPriority -> Either SomeException a -> Action (Seconds, a)
actionAlwaysRequeuePriority (forall {a} {b}. Either a b -> PoolPriority
priority Either SomeException a
res) Either SomeException a
res

actionAlwaysRequeuePriority :: PoolPriority -> Either SomeException a -> Action (Seconds, a)
actionAlwaysRequeuePriority :: forall a.
PoolPriority -> Either SomeException a -> Action (Seconds, a)
actionAlwaysRequeuePriority PoolPriority
pri Either SomeException a
res = forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ 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 :: 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]
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]
..} <- forall k v ro rw. RAW k v ro rw ro
getRO
    IO Seconds
offset <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (IO Seconds)
offsetTime
    forall a k v ro rw.
Capture (Either SomeException a) -> RAW k v ro rw a
captureRAW forall a b. (a -> b) -> a -> b
$ \Either SomeException (Seconds, a) -> IO ()
continue ->
        forall a. PoolPriority -> Pool -> IO a -> IO ()
addPool PoolPriority
pri Pool
globalPool forall a b. (a -> b) -> a -> b
$ do
            Seconds
offset <- IO Seconds
offset
            Either SomeException (Seconds, a) -> IO ()
continue forall a b. (a -> b) -> a -> b
$ (Seconds
offset,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either SomeException a
res