diff --git a/ChangeLog.md b/ChangeLog.md index 6eb5cf0e40..d23ec3eadd 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -29,6 +29,7 @@ Other enhancements: relevant on Linux where different distributions may have different combinations of libtinfo 5/6, ncurses 5/6, and gmp 4/5, and will allow simpifying the setup-info metadata YAML for future GHC releases. +* The build progress bar reports names of packages currently building. * `stack setup --verbose` causes verbose output of GHC configure process. See [#3716](https://github.com/commercialhaskell/stack/issues/3716) diff --git a/src/Control/Concurrent/Execute.hs b/src/Control/Concurrent/Execute.hs index 2a10662d1a..97439b17bb 100644 --- a/src/Control/Concurrent/Execute.hs +++ b/src/Control/Concurrent/Execute.hs @@ -73,7 +73,7 @@ instance Show ExecuteException where runActions :: Int -- ^ threads -> Bool -- ^ keep going after one task has failed -> [Action] - -> (TVar Int -> IO ()) -- ^ progress updated + -> (TVar Int -> TVar (Set ActionId) -> IO ()) -- ^ progress updated -> IO [SomeException] runActions threads keepGoing actions0 withProgress = do es <- ExecuteState @@ -82,7 +82,7 @@ runActions threads keepGoing actions0 withProgress = do <*> newTVarIO Set.empty <*> newTVarIO 0 <*> pure keepGoing - _ <- async $ withProgress $ esCompleted es + _ <- async $ withProgress (esCompleted es) (esInAction es) if threads <= 1 then runActions' es else replicateConcurrently_ threads $ runActions' es diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 789e8f1a3f..8bc3f7647e 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -628,14 +628,20 @@ executePlan' installedMap0 targets plan ee@ExecuteEnv {..} = do let keepGoing = fromMaybe (not (M.null (planFinals plan))) (boptsKeepGoing eeBuildOpts) terminal <- view terminalL - errs <- liftIO $ runActions threads keepGoing actions $ \doneVar -> do + errs <- liftIO $ runActions threads keepGoing actions $ \doneVar actionsVar -> do let total = length actions loop prev | prev == total = run $ logStickyDone ("Completed " <> T.pack (show total) <> " action(s).") | otherwise = do + inProgress <- readTVarIO actionsVar + let packageNames = map (\(ActionId pkgID _) -> packageIdentifierText pkgID) (toList inProgress) + nowBuilding [] = "" + nowBuilding names = ": " <> T.intercalate ", " names when terminal $ run $ - logSticky ("Progress: " <> T.pack (show prev) <> "/" <> T.pack (show total)) + logSticky $ + "Progress " <> T.pack (show prev) <> "/" <> T.pack (show total) <> + nowBuilding packageNames done <- atomically $ do done <- readTVar doneVar check $ done /= prev