    {-# 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 x :: Either a b
    x = if Either a b -> Bool
    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 :: PoolPriority
    -> Action a
    -> Action (Fence IO (Either SomeException (Seconds, a)))
    addPoolWait pri :: PoolPriority
    pri act :: Action a
    act = do
        ro :: Global
    ro@Global{..} <- 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
        Local
    rw <- RAW ([String], [Key]) [Value] Global Local Local -> Action Local
    forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
    Action RAW ([String], [Key]) [Value] Global Local Local
    forall k v ro rw. RAW k v ro rw rw
    getRW
        IO (Fence IO (Either SomeException (Seconds, a)))
    -> Action (Fence IO (Either SomeException (Seconds, a)))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Fence IO (Either SomeException (Seconds, a)))
     -> Action (Fence IO (Either SomeException (Seconds, a))))
    -> IO (Fence IO (Either SomeException (Seconds, a)))
    -> Action (Fence IO (Either SomeException (Seconds, a)))
    forall a b. (a -> b) -> a -> b
    $ do
            Fence IO (Either SomeException (Seconds, a))
    fence <- IO (Fence IO (Either SomeException (Seconds, a)))
    forall (m :: * -> *) a. MonadIO m => IO (Fence m a)
    newFence
            let act2 :: Action (Seconds, a)
    act2 = do IO Seconds
    offset <- IO (IO Seconds) -> Action (IO Seconds)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO (IO Seconds)
    offsetTime; a
    res <- Action a
    act; Seconds
    offset <- IO Seconds -> Action Seconds
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO Seconds
    offset; (Seconds, a) -> Action (Seconds, a)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Seconds
    offset, a
    res)
            PoolPriority -> Pool -> IO () -> IO ()
    forall a. PoolPriority -> Pool -> IO a -> IO ()
    addPool PoolPriority
    pri Pool
    globalPool (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Global
    -> Local
    -> Action (Seconds, a)
    -> Capture (Either SomeException (Seconds, a))
    forall a.
    Global -> Local -> Action a -> Capture (Either SomeException a)
    runAction Global
    ro Local
    rw Action (Seconds, a)
    act2 Capture (Either SomeException (Seconds, a))
    -> Capture (Either SomeException (Seconds, a))
    forall a b. (a -> b) -> a -> b
    $ Fence IO (Either SomeException (Seconds, a))
    -> Either SomeException (Seconds, a) -> IO ()
    forall (m :: * -> *) a.
    (Partial, MonadIO m) =>
    Fence m a -> a -> m ()
    signalFence Fence IO (Either SomeException (Seconds, a))
    fence
            Fence IO (Either SomeException (Seconds, a))
    -> IO (Fence IO (Either SomeException (Seconds, a)))
    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_ :: PoolPriority -> Action a -> Action ()
    addPoolWait_ pri :: PoolPriority
    pri act :: Action a
    act = do
        ro :: Global
    ro@Global{..} <- 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
        Local
    rw <- RAW ([String], [Key]) [Value] Global Local Local -> Action Local
    forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
    Action RAW ([String], [Key]) [Value] Global Local Local
    forall k v ro rw. RAW k v ro rw rw
    getRW
        IO () -> Action ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Action ()) -> IO () -> Action ()
    forall a b. (a -> b) -> a -> b
    $ PoolPriority -> Pool -> IO () -> IO ()
    forall a. PoolPriority -> Pool -> IO a -> IO ()
    addPool PoolPriority
    pri Pool
    globalPool (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Global -> Local -> Action a -> Capture (Either SomeException a)
    forall a.
    Global -> Local -> Action a -> Capture (Either SomeException a)
    runAction Global
    ro Local
    rw Action a
    act Capture (Either SomeException a)
    -> Capture (Either SomeException a)
    forall a b. (a -> b) -> a -> b
    $ \_ -> () -> IO ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

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

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

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