driver: Correctly pass custom messenger to logging function

This was an oversight from !6718

7 files changed, 36 insertions, 32 deletions

diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 33cfbfe4f4..1d77bf6898 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -920,6 +920,7 @@ data MakeEnv = MakeEnv { hsc_env :: HscEnv -- The basic HscEnv which will be aug
                        , old_hpt :: HomePackageTable -- A cache of old interface files
                        , compile_sem :: AbstractSem
                        , lqq_var :: TVar LogQueueQueue
+                       , env_messager :: Maybe Messager
                        }
 
 type RunMakeM a = ReaderT MakeEnv (MaybeT IO) a
@@ -1028,9 +1029,9 @@ upsweep
     -> (NodeKey -> [NodeKey]) -- A function which computes the direct dependencies of a NodeKey
     -> [BuildPlan]
     -> IO (SuccessFlag, HscEnv)
-upsweep n_jobs hsc_env _mHscMessage old_hpt direct_deps build_plan = do
+upsweep n_jobs hsc_env mHscMessage old_hpt direct_deps build_plan = do
     (cycle, pipelines, collect_result) <- interpretBuildPlan direct_deps build_plan
-    runPipelines n_jobs hsc_env old_hpt pipelines
+    runPipelines n_jobs hsc_env old_hpt mHscMessage pipelines
     res <- collect_result
 
     let completed = [m | Just (Just m) <- res]
@@ -2252,7 +2253,8 @@ executeInstantiationNode k n wait_deps iu = do
         -- Output of the logger is mediated by a central worker to
         -- avoid output interleaving
         let lcl_hsc_env = setHPT deps hsc_env
-        lift $ MaybeT $ wrapAction lcl_hsc_env $ upsweep_inst lcl_hsc_env (Just batchMsg) k n iu
+        msg <- asks env_messager
+        lift $ MaybeT $ wrapAction lcl_hsc_env $ upsweep_inst lcl_hsc_env msg k n iu
 
 executeCompileNode :: Int
   -> Int
@@ -2282,7 +2284,7 @@ executeCompileNode k n wait_deps mknot_var mod = do
              hsc_env { hsc_type_env_vars = knotVarsFromModuleEnv knot_var }
      -- Compile the module, locking with a semphore to avoid too many modules
      -- being compiled at the same time leading to high memory usage.
-     lift $ MaybeT (withAbstractSem compile_sem $ wrapAction lcl_hsc_env $ upsweep_mod lcl_hsc_env (Just batchMsg) old_hpt mod k n)
+     lift $ MaybeT (withAbstractSem compile_sem $ wrapAction lcl_hsc_env $ upsweep_mod lcl_hsc_env env_messager old_hpt mod k n)
 
 executeTypecheckLoop :: IO HomePackageTable -- Dependencies of the loop
   -> RunMakeM [HomeModInfo] -- The loop itself
@@ -2349,9 +2351,10 @@ label_self thread_name = do
 runPipelines :: Int              -- ^ How many capabilities to use
              -> HscEnv           -- ^ The basic HscEnv which is augmented with specific info for each module
              -> HomePackageTable -- ^ The old HPT which is used as a cache (TODO: The cache should be from the ActionMap)
+             -> Maybe Messager   -- ^ Optional custom messager to use to report progress
              -> [MakeAction]  -- ^ The build plan for all the module nodes
              -> IO ()
-runPipelines n_jobs orig_hsc_env old_hpt all_pipelines = do
+runPipelines n_jobs orig_hsc_env old_hpt mHscMessager all_pipelines = do
 
   liftIO $ label_self "main --make thread"
 
@@ -2395,6 +2398,7 @@ runPipelines n_jobs orig_hsc_env old_hpt all_pipelines = do
                     , old_hpt = old_hpt
                     , lqq_var = log_queue_queue_var
                     , compile_sem = abstract_sem
+                    , env_messager = mHscMessager
                     }
 
   MC.bracket updNumCapabilities resetNumCapabilities $ \_ ->
diff --git a/testsuite/tests/backpack/reexport/bkpreex03.stdout b/testsuite/tests/backpack/reexport/bkpreex03.stdout
index f35b52c198..ddd2552e5a 100644
--- a/testsuite/tests/backpack/reexport/bkpreex03.stdout
+++ b/testsuite/tests/backpack/reexport/bkpreex03.stdout
@@ -1,6 +1,6 @@
 [1 of 1] Processing p
-[1 of 3] Compiling M1
-[2 of 3] Compiling M2
-[3 of 3] Compiling A[sig]
+  [1 of 3] Compiling M1
+  [2 of 3] Compiling M2
+  [3 of 3] Compiling A[sig]
 [1 of 1] Processing p
-[3 of 3] Compiling A[sig] [M2 added]
+  [3 of 3] Compiling A[sig] [M2 added]
diff --git a/testsuite/tests/backpack/reexport/bkpreex04.stdout b/testsuite/tests/backpack/reexport/bkpreex04.stdout
index 376747c456..7ed3acaa1d 100644
--- a/testsuite/tests/backpack/reexport/bkpreex04.stdout
+++ b/testsuite/tests/backpack/reexport/bkpreex04.stdout
@@ -1,5 +1,5 @@
 [1 of 1] Processing p
-[1 of 2] Compiling A[sig]
-[2 of 2] Compiling B[sig]
+  [1 of 2] Compiling A[sig]
+  [2 of 2] Compiling B[sig]
 [1 of 1] Processing p
-[2 of 2] Compiling A[sig] [B added]
+  [2 of 2] Compiling A[sig] [B added]
diff --git a/testsuite/tests/backpack/should_compile/bkp58.stderr b/testsuite/tests/backpack/should_compile/bkp58.stderr
index a33a9d66bc..3f36e43701 100644
--- a/testsuite/tests/backpack/should_compile/bkp58.stderr
+++ b/testsuite/tests/backpack/should_compile/bkp58.stderr
@@ -1,13 +1,13 @@
 [1 of 3] Processing common
   Instantiating common
-[1 of 1] Compiling Class            ( common/Class.hs, bkp58.out/common/Class.o )
+  [1 of 1] Compiling Class            ( common/Class.hs, bkp58.out/common/Class.o )
 [2 of 3] Processing consumer-impl
   Instantiating consumer-impl
   [1 of 1] Including common
-[1 of 3] Compiling Impl[boot]       ( consumer-impl/Impl.hs-boot, bkp58.out/consumer-impl/Impl.o-boot )
-[2 of 3] Compiling Downstream       ( consumer-impl/Downstream.hs, bkp58.out/consumer-impl/Downstream.o )
-[3 of 3] Compiling Impl             ( consumer-impl/Impl.hs, bkp58.out/consumer-impl/Impl.o )
+  [1 of 3] Compiling Impl[boot]       ( consumer-impl/Impl.hs-boot, bkp58.out/consumer-impl/Impl.o-boot )
+  [2 of 3] Compiling Downstream       ( consumer-impl/Downstream.hs, bkp58.out/consumer-impl/Downstream.o )
+  [3 of 3] Compiling Impl             ( consumer-impl/Impl.hs, bkp58.out/consumer-impl/Impl.o )
 [3 of 3] Processing tie
   Instantiating tie
   [1 of 1] Including consumer-impl
-[1 of 1] Compiling Tie              ( tie/Tie.hs, bkp58.out/tie/Tie.o )
+  [1 of 1] Compiling Tie              ( tie/Tie.hs, bkp58.out/tie/Tie.o )
diff --git a/testsuite/tests/backpack/should_compile/bkp60.stderr b/testsuite/tests/backpack/should_compile/bkp60.stderr
index 8e22b1058e..6a5732b961 100644
--- a/testsuite/tests/backpack/should_compile/bkp60.stderr
+++ b/testsuite/tests/backpack/should_compile/bkp60.stderr
@@ -1,13 +1,13 @@
 [1 of 3] Processing common
   Instantiating common
-[1 of 1] Compiling Class            ( common/Class.hs, bkp60.out/common/Class.o )
+  [1 of 1] Compiling Class            ( common/Class.hs, bkp60.out/common/Class.o )
 [2 of 3] Processing consumer-impl
   Instantiating consumer-impl
   [1 of 1] Including common
-[1 of 3] Compiling Impl[boot]       ( consumer-impl/Impl.hs-boot, bkp60.out/consumer-impl/Impl.o-boot )
-[2 of 3] Compiling Downstream       ( consumer-impl/Downstream.hs, bkp60.out/consumer-impl/Downstream.o )
-[3 of 3] Compiling Impl             ( consumer-impl/Impl.hs, bkp60.out/consumer-impl/Impl.o )
+  [1 of 3] Compiling Impl[boot]       ( consumer-impl/Impl.hs-boot, bkp60.out/consumer-impl/Impl.o-boot )
+  [2 of 3] Compiling Downstream       ( consumer-impl/Downstream.hs, bkp60.out/consumer-impl/Downstream.o )
+  [3 of 3] Compiling Impl             ( consumer-impl/Impl.hs, bkp60.out/consumer-impl/Impl.o )
 [3 of 3] Processing tie
   Instantiating tie
   [1 of 1] Including consumer-impl
-[1 of 1] Compiling Tie              ( tie/Tie.hs, bkp60.out/tie/Tie.o )
+  [1 of 1] Compiling Tie              ( tie/Tie.hs, bkp60.out/tie/Tie.o )
diff --git a/testsuite/tests/backpack/should_fail/bkpfail28.stderr b/testsuite/tests/backpack/should_fail/bkpfail28.stderr
index d6f267648c..7e90a61af7 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail28.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail28.stderr
@@ -1,10 +1,10 @@
 [1 of 3] Processing p
-[1 of 1] Compiling A[sig]           ( p/A.hsig, nothing )
+  [1 of 1] Compiling A[sig]           ( p/A.hsig, nothing )
 [2 of 3] Processing q
-[1 of 1] Compiling A[sig]           ( q/A.hsig, nothing )
+  [1 of 1] Compiling A[sig]           ( q/A.hsig, nothing )
 [3 of 3] Processing r
-[1 of 4] Compiling A[sig]           ( r/A.hsig, nothing )
-[2 of 4] Compiling R                ( r/R.hs, nothing )
+  [1 of 4] Compiling A[sig]           ( r/A.hsig, nothing )
+  [2 of 4] Compiling R                ( r/R.hs, nothing )
 
 bkpfail28.bkp:19:13: error:
     • Overlapping instances for Show (K a) arising from a use of ‘show’
@@ -25,5 +25,5 @@ bkpfail28.bkp:21:13: error:
           -- Defined at bkpfail28.bkp:12:18
     • In the expression: show
       In an equation for ‘g’: g = show
-[3 of 4] Instantiating p
-[4 of 4] Instantiating q
+  [3 of 4] Instantiating p
+  [4 of 4] Instantiating q
diff --git a/testsuite/tests/backpack/should_fail/bkpfail49.stderr b/testsuite/tests/backpack/should_fail/bkpfail49.stderr
index a140bbfade..b6b60e2b86 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail49.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail49.stderr
@@ -1,10 +1,10 @@
 [1 of 2] Processing p
-[1 of 1] Compiling A[sig]           ( p/A.hsig, nothing )
+  [1 of 1] Compiling A[sig]           ( p/A.hsig, nothing )
 [2 of 2] Processing q
-[1 of 3] Compiling A[sig]           ( q/A.hsig, nothing )
-[2 of 3] Compiling M                ( q/M.hs, nothing )
+  [1 of 3] Compiling A[sig]           ( q/A.hsig, nothing )
+  [2 of 3] Compiling M                ( q/M.hs, nothing )
 
 bkpfail49.bkp:11:13: error:
     Not in scope: data constructor ‘A.True’
     Module ‘A’ does not export ‘True’.
-[3 of 3] Instantiating p
+  [3 of 3] Instantiating p