Report currently building packages along with "Progress:" label

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)
 

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

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