{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards    #-}
-- Concurrent execution with dependencies. Types currently hard-coded for needs
-- of stack, but could be generalized easily.
module Control.Concurrent.Execute
    ( ActionType (..)
    , ActionId (..)
    , ActionContext (..)
    , Action (..)
    , Concurrency(..)
    , runActions
    ) where

import           Control.Concurrent.STM   (retry)
import           Stack.Prelude
import           Data.List (sortBy)
import qualified Data.Set                 as Set

data ActionType
    = ATBuild
      -- ^ Action for building a package's library and executables. If
      -- 'taskAllInOne' is 'True', then this will also build benchmarks
      -- and tests. It is 'False' when then library's benchmarks or
      -- test-suites have cyclic dependencies.
    | ATBuildFinal
      -- ^ Task for building the package's benchmarks and test-suites.
      -- Requires that the library was already built.
    | ATRunTests
      -- ^ Task for running the package's test-suites.
    | ATRunBenchmarks
      -- ^ Task for running the package's benchmarks.
    deriving (Int -> ActionType -> ShowS
[ActionType] -> ShowS
ActionType -> String
(Int -> ActionType -> ShowS)
-> (ActionType -> String)
-> ([ActionType] -> ShowS)
-> Show ActionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActionType] -> ShowS
$cshowList :: [ActionType] -> ShowS
show :: ActionType -> String
$cshow :: ActionType -> String
showsPrec :: Int -> ActionType -> ShowS
$cshowsPrec :: Int -> ActionType -> ShowS
Show, ActionType -> ActionType -> Bool
(ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> Bool) -> Eq ActionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionType -> ActionType -> Bool
$c/= :: ActionType -> ActionType -> Bool
== :: ActionType -> ActionType -> Bool
$c== :: ActionType -> ActionType -> Bool
Eq, Eq ActionType
Eq ActionType
-> (ActionType -> ActionType -> Ordering)
-> (ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> ActionType)
-> (ActionType -> ActionType -> ActionType)
-> Ord ActionType
ActionType -> ActionType -> Bool
ActionType -> ActionType -> Ordering
ActionType -> ActionType -> ActionType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ActionType -> ActionType -> ActionType
$cmin :: ActionType -> ActionType -> ActionType
max :: ActionType -> ActionType -> ActionType
$cmax :: ActionType -> ActionType -> ActionType
>= :: ActionType -> ActionType -> Bool
$c>= :: ActionType -> ActionType -> Bool
> :: ActionType -> ActionType -> Bool
$c> :: ActionType -> ActionType -> Bool
<= :: ActionType -> ActionType -> Bool
$c<= :: ActionType -> ActionType -> Bool
< :: ActionType -> ActionType -> Bool
$c< :: ActionType -> ActionType -> Bool
compare :: ActionType -> ActionType -> Ordering
$ccompare :: ActionType -> ActionType -> Ordering
$cp1Ord :: Eq ActionType
Ord)
data ActionId = ActionId !PackageIdentifier !ActionType
    deriving (Int -> ActionId -> ShowS
[ActionId] -> ShowS
ActionId -> String
(Int -> ActionId -> ShowS)
-> (ActionId -> String) -> ([ActionId] -> ShowS) -> Show ActionId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActionId] -> ShowS
$cshowList :: [ActionId] -> ShowS
show :: ActionId -> String
$cshow :: ActionId -> String
showsPrec :: Int -> ActionId -> ShowS
$cshowsPrec :: Int -> ActionId -> ShowS
Show, ActionId -> ActionId -> Bool
(ActionId -> ActionId -> Bool)
-> (ActionId -> ActionId -> Bool) -> Eq ActionId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionId -> ActionId -> Bool
$c/= :: ActionId -> ActionId -> Bool
== :: ActionId -> ActionId -> Bool
$c== :: ActionId -> ActionId -> Bool
Eq, Eq ActionId
Eq ActionId
-> (ActionId -> ActionId -> Ordering)
-> (ActionId -> ActionId -> Bool)
-> (ActionId -> ActionId -> Bool)
-> (ActionId -> ActionId -> Bool)
-> (ActionId -> ActionId -> Bool)
-> (ActionId -> ActionId -> ActionId)
-> (ActionId -> ActionId -> ActionId)
-> Ord ActionId
ActionId -> ActionId -> Bool
ActionId -> ActionId -> Ordering
ActionId -> ActionId -> ActionId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ActionId -> ActionId -> ActionId
$cmin :: ActionId -> ActionId -> ActionId
max :: ActionId -> ActionId -> ActionId
$cmax :: ActionId -> ActionId -> ActionId
>= :: ActionId -> ActionId -> Bool
$c>= :: ActionId -> ActionId -> Bool
> :: ActionId -> ActionId -> Bool
$c> :: ActionId -> ActionId -> Bool
<= :: ActionId -> ActionId -> Bool
$c<= :: ActionId -> ActionId -> Bool
< :: ActionId -> ActionId -> Bool
$c< :: ActionId -> ActionId -> Bool
compare :: ActionId -> ActionId -> Ordering
$ccompare :: ActionId -> ActionId -> Ordering
$cp1Ord :: Eq ActionId
Ord)
data Action = Action
    { Action -> ActionId
actionId :: !ActionId
    , Action -> Set ActionId
actionDeps :: !(Set ActionId)
    , Action -> ActionContext -> IO ()
actionDo :: !(ActionContext -> IO ())
    , Action -> Concurrency
actionConcurrency :: !Concurrency
    }

data Concurrency = ConcurrencyAllowed | ConcurrencyDisallowed
    deriving (Concurrency -> Concurrency -> Bool
(Concurrency -> Concurrency -> Bool)
-> (Concurrency -> Concurrency -> Bool) -> Eq Concurrency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Concurrency -> Concurrency -> Bool
$c/= :: Concurrency -> Concurrency -> Bool
== :: Concurrency -> Concurrency -> Bool
$c== :: Concurrency -> Concurrency -> Bool
Eq)

data ActionContext = ActionContext
    { ActionContext -> Set ActionId
acRemaining :: !(Set ActionId)
    -- ^ Does not include the current action
    , ActionContext -> [Action]
acDownstream :: [Action]
    -- ^ Actions which depend on the current action
    , ActionContext -> Concurrency
acConcurrency :: !Concurrency
    -- ^ Whether this action may be run concurrently with others
    }

data ExecuteState = ExecuteState
    { ExecuteState -> TVar [Action]
esActions    :: TVar [Action]
    , ExecuteState -> TVar [SomeException]
esExceptions :: TVar [SomeException]
    , ExecuteState -> TVar (Set ActionId)
esInAction   :: TVar (Set ActionId)
    , ExecuteState -> TVar Int
esCompleted  :: TVar Int
    , ExecuteState -> Bool
esKeepGoing  :: Bool
    }

data ExecuteException
    = InconsistentDependencies
    deriving Typeable
instance Exception ExecuteException

instance Show ExecuteException where
    show :: ExecuteException -> String
show ExecuteException
InconsistentDependencies =
        String
"Inconsistent dependencies were discovered while executing your build plan. This should never happen, please report it as a bug to the stack team."

runActions :: Int -- ^ threads
           -> Bool -- ^ keep going after one task has failed
           -> [Action]
           -> (TVar Int -> TVar (Set ActionId) -> IO ()) -- ^ progress updated
           -> IO [SomeException]
runActions :: Int
-> Bool
-> [Action]
-> (TVar Int -> TVar (Set ActionId) -> IO ())
-> IO [SomeException]
runActions Int
threads Bool
keepGoing [Action]
actions0 TVar Int -> TVar (Set ActionId) -> IO ()
withProgress = do
    ExecuteState
es <- TVar [Action]
-> TVar [SomeException]
-> TVar (Set ActionId)
-> TVar Int
-> Bool
-> ExecuteState
ExecuteState
        (TVar [Action]
 -> TVar [SomeException]
 -> TVar (Set ActionId)
 -> TVar Int
 -> Bool
 -> ExecuteState)
-> IO (TVar [Action])
-> IO
     (TVar [SomeException]
      -> TVar (Set ActionId) -> TVar Int -> Bool -> ExecuteState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Action] -> IO (TVar [Action])
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO ([Action] -> [Action]
sortActions [Action]
actions0)
        IO
  (TVar [SomeException]
   -> TVar (Set ActionId) -> TVar Int -> Bool -> ExecuteState)
-> IO (TVar [SomeException])
-> IO (TVar (Set ActionId) -> TVar Int -> Bool -> ExecuteState)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [SomeException] -> IO (TVar [SomeException])
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO []
        IO (TVar (Set ActionId) -> TVar Int -> Bool -> ExecuteState)
-> IO (TVar (Set ActionId))
-> IO (TVar Int -> Bool -> ExecuteState)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set ActionId -> IO (TVar (Set ActionId))
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Set ActionId
forall a. Set a
Set.empty
        IO (TVar Int -> Bool -> ExecuteState)
-> IO (TVar Int) -> IO (Bool -> ExecuteState)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO (TVar Int)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Int
0
        IO (Bool -> ExecuteState) -> IO Bool -> IO ExecuteState
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
keepGoing
    Async ()
_ <- IO () -> IO (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ TVar Int -> TVar (Set ActionId) -> IO ()
withProgress (ExecuteState -> TVar Int
esCompleted ExecuteState
es) (ExecuteState -> TVar (Set ActionId)
esInAction ExecuteState
es)
    if Int
threads Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
        then ExecuteState -> IO ()
runActions' ExecuteState
es
        else Int -> IO () -> IO ()
forall (m :: * -> *) a.
(Applicative m, MonadUnliftIO m) =>
Int -> m a -> m ()
replicateConcurrently_ Int
threads (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ExecuteState -> IO ()
runActions' ExecuteState
es
    TVar [SomeException] -> IO [SomeException]
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO (TVar [SomeException] -> IO [SomeException])
-> TVar [SomeException] -> IO [SomeException]
forall a b. (a -> b) -> a -> b
$ ExecuteState -> TVar [SomeException]
esExceptions ExecuteState
es

-- | Sort actions such that those that can't be run concurrently are at
-- the end.
sortActions :: [Action] -> [Action]
sortActions :: [Action] -> [Action]
sortActions = (Action -> Action -> Ordering) -> [Action] -> [Action]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Concurrency -> Concurrency -> Ordering
compareConcurrency (Concurrency -> Concurrency -> Ordering)
-> (Action -> Concurrency) -> Action -> Action -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Action -> Concurrency
actionConcurrency)
  where
    -- NOTE: Could derive Ord. However, I like to make this explicit so
    -- that changes to the datatype must consider how it's affecting
    -- this.
    compareConcurrency :: Concurrency -> Concurrency -> Ordering
compareConcurrency Concurrency
ConcurrencyAllowed Concurrency
ConcurrencyDisallowed = Ordering
LT
    compareConcurrency Concurrency
ConcurrencyDisallowed Concurrency
ConcurrencyAllowed = Ordering
GT
    compareConcurrency Concurrency
_ Concurrency
_ = Ordering
EQ

runActions' :: ExecuteState -> IO ()
runActions' :: ExecuteState -> IO ()
runActions' ExecuteState {Bool
TVar Int
TVar [SomeException]
TVar [Action]
TVar (Set ActionId)
esKeepGoing :: Bool
esCompleted :: TVar Int
esInAction :: TVar (Set ActionId)
esExceptions :: TVar [SomeException]
esActions :: TVar [Action]
esKeepGoing :: ExecuteState -> Bool
esCompleted :: ExecuteState -> TVar Int
esInAction :: ExecuteState -> TVar (Set ActionId)
esExceptions :: ExecuteState -> TVar [SomeException]
esActions :: ExecuteState -> TVar [Action]
..} =
    IO ()
loop
  where
    breakOnErrs :: STM (m ()) -> STM (m ())
breakOnErrs STM (m ())
inner = do
        [SomeException]
errs <- TVar [SomeException] -> STM [SomeException]
forall a. TVar a -> STM a
readTVar TVar [SomeException]
esExceptions
        if [SomeException] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SomeException]
errs Bool -> Bool -> Bool
|| Bool
esKeepGoing
            then STM (m ())
inner
            else m () -> STM (m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (m () -> STM (m ())) -> m () -> STM (m ())
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    withActions :: ([Action] -> STM (m ())) -> STM (m ())
withActions [Action] -> STM (m ())
inner = do
        [Action]
as <- TVar [Action] -> STM [Action]
forall a. TVar a -> STM a
readTVar TVar [Action]
esActions
        if [Action] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Action]
as
            then m () -> STM (m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (m () -> STM (m ())) -> m () -> STM (m ())
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            else [Action] -> STM (m ())
inner [Action]
as
    loop :: IO ()
loop = 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
$ STM (IO ()) -> IO (IO ())
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM (IO ()) -> IO (IO ())) -> STM (IO ()) -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ STM (IO ()) -> STM (IO ())
forall (m :: * -> *). Monad m => STM (m ()) -> STM (m ())
breakOnErrs (STM (IO ()) -> STM (IO ())) -> STM (IO ()) -> STM (IO ())
forall a b. (a -> b) -> a -> b
$ ([Action] -> STM (IO ())) -> STM (IO ())
forall (m :: * -> *).
Monad m =>
([Action] -> STM (m ())) -> STM (m ())
withActions (([Action] -> STM (IO ())) -> STM (IO ()))
-> ([Action] -> STM (IO ())) -> STM (IO ())
forall a b. (a -> b) -> a -> b
$ \[Action]
as ->
        case (Action -> Bool) -> [Action] -> ([Action], [Action])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Set ActionId -> Bool
forall a. Set a -> Bool
Set.null (Set ActionId -> Bool)
-> (Action -> Set ActionId) -> Action -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Action -> Set ActionId
actionDeps) [Action]
as of
            ([Action]
_, []) -> do
                Set ActionId
inAction <- TVar (Set ActionId) -> STM (Set ActionId)
forall a. TVar a -> STM a
readTVar TVar (Set ActionId)
esInAction
                if Set ActionId -> Bool
forall a. Set a -> Bool
Set.null Set ActionId
inAction
                    then do
                        Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
esKeepGoing (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$
                            TVar [SomeException]
-> ([SomeException] -> [SomeException]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar [SomeException]
esExceptions (ExecuteException -> SomeException
forall e. Exception e => e -> SomeException
toException ExecuteException
InconsistentDependenciesSomeException -> [SomeException] -> [SomeException]
forall a. a -> [a] -> [a]
:)
                        IO () -> STM (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    else STM (IO ())
forall a. STM a
retry
            ([Action]
xs, Action
action:[Action]
ys) -> do
                Set ActionId
inAction <- TVar (Set ActionId) -> STM (Set ActionId)
forall a. TVar a -> STM a
readTVar TVar (Set ActionId)
esInAction
                case Action -> Concurrency
actionConcurrency Action
action of
                  Concurrency
ConcurrencyAllowed -> () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  Concurrency
ConcurrencyDisallowed -> Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set ActionId -> Bool
forall a. Set a -> Bool
Set.null Set ActionId
inAction) STM ()
forall a. STM a
retry
                let as' :: [Action]
as' = [Action]
xs [Action] -> [Action] -> [Action]
forall a. [a] -> [a] -> [a]
++ [Action]
ys
                    remaining :: Set ActionId
remaining = Set ActionId -> Set ActionId -> Set ActionId
forall a. Ord a => Set a -> Set a -> Set a
Set.union
                        ([ActionId] -> Set ActionId
forall a. Ord a => [a] -> Set a
Set.fromList ([ActionId] -> Set ActionId) -> [ActionId] -> Set ActionId
forall a b. (a -> b) -> a -> b
$ (Action -> ActionId) -> [Action] -> [ActionId]
forall a b. (a -> b) -> [a] -> [b]
map Action -> ActionId
actionId [Action]
as')
                        Set ActionId
inAction
                TVar [Action] -> [Action] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar [Action]
esActions [Action]
as'
                TVar (Set ActionId) -> (Set ActionId -> Set ActionId) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (Set ActionId)
esInAction (ActionId -> Set ActionId -> Set ActionId
forall a. Ord a => a -> Set a -> Set a
Set.insert (ActionId -> Set ActionId -> Set ActionId)
-> ActionId -> Set ActionId -> Set ActionId
forall a b. (a -> b) -> a -> b
$ Action -> ActionId
actionId Action
action)
                IO () -> STM (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
forall a b. (a -> b) -> a -> b
$ ((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. IO a -> IO a) -> IO ()) -> IO ())
-> ((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
                    Either SomeException ()
eres <- IO () -> IO (Either SomeException ())
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall a. IO a -> IO a
restore (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Action -> ActionContext -> IO ()
actionDo Action
action ActionContext :: Set ActionId -> [Action] -> Concurrency -> ActionContext
ActionContext
                        { acRemaining :: Set ActionId
acRemaining = Set ActionId
remaining
                        , acDownstream :: [Action]
acDownstream = ActionId -> [Action] -> [Action]
downstreamActions (Action -> ActionId
actionId Action
action) [Action]
as'
                        , acConcurrency :: Concurrency
acConcurrency = Action -> Concurrency
actionConcurrency Action
action
                        }
                    STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                        TVar (Set ActionId) -> (Set ActionId -> Set ActionId) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (Set ActionId)
esInAction (ActionId -> Set ActionId -> Set ActionId
forall a. Ord a => a -> Set a -> Set a
Set.delete (ActionId -> Set ActionId -> Set ActionId)
-> ActionId -> Set ActionId -> Set ActionId
forall a b. (a -> b) -> a -> b
$ Action -> ActionId
actionId Action
action)
                        TVar Int -> (Int -> Int) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar Int
esCompleted (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                        case Either SomeException ()
eres of
                            Left SomeException
err -> TVar [SomeException]
-> ([SomeException] -> [SomeException]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar [SomeException]
esExceptions (SomeException
errSomeException -> [SomeException] -> [SomeException]
forall a. a -> [a] -> [a]
:)
                            Right () ->
                                let dropDep :: Action -> Action
dropDep Action
a = Action
a { actionDeps :: Set ActionId
actionDeps = ActionId -> Set ActionId -> Set ActionId
forall a. Ord a => a -> Set a -> Set a
Set.delete (Action -> ActionId
actionId Action
action) (Set ActionId -> Set ActionId) -> Set ActionId -> Set ActionId
forall a b. (a -> b) -> a -> b
$ Action -> Set ActionId
actionDeps Action
a }
                                 in TVar [Action] -> ([Action] -> [Action]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar [Action]
esActions (([Action] -> [Action]) -> STM ())
-> ([Action] -> [Action]) -> STM ()
forall a b. (a -> b) -> a -> b
$ (Action -> Action) -> [Action] -> [Action]
forall a b. (a -> b) -> [a] -> [b]
map Action -> Action
dropDep
                    IO () -> IO ()
forall a. IO a -> IO a
restore IO ()
loop

downstreamActions :: ActionId -> [Action] -> [Action]
downstreamActions :: ActionId -> [Action] -> [Action]
downstreamActions ActionId
aid = (Action -> Bool) -> [Action] -> [Action]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Action
a -> ActionId
aid ActionId -> Set ActionId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Action -> Set ActionId
actionDeps Action
a)