diff options
Diffstat (limited to 'ghc/GHCi/UI.hs')
| -rw-r--r-- | ghc/GHCi/UI.hs | 26 |
1 files changed, 12 insertions, 14 deletions
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index 48886ea88f..7dc253b894 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -58,7 +58,7 @@ import GHC.Driver.Config import qualified GHC import GHC ( LoadHowMuch(..), Target(..), TargetId(..), Resume, SingleStep, Ghc, - GetDocsFailure(..), + GetDocsFailure(..), putLogMsgM, pushLogHookM, getModuleGraph, handleSourceError, ms_mod ) import GHC.Driver.Main (hscParseDeclsWithLocation, hscParseStmtWithLocation) import GHC.Hs.ImpExp @@ -86,6 +86,7 @@ import GHC.Unit.Module.ModSummary import GHC.Data.StringBuffer import GHC.Utils.Outputable +import GHC.Utils.Logger -- Other random utilities import GHC.Types.Basic hiding ( isTopLevel ) @@ -478,13 +479,10 @@ interactiveUI config srcs maybe_exprs = do $ dflags GHC.setInteractiveDynFlags dflags' + -- Update the LogAction. Ensure we don't override the user's log action lest + -- we break -ddump-json (#14078) lastErrLocationsRef <- liftIO $ newIORef [] - progDynFlags <- GHC.getProgramDynFlags - _ <- GHC.setProgramDynFlags $ - -- Ensure we don't override the user's log action lest we break - -- -ddump-json (#14078) - progDynFlags { log_action = ghciLogAction (log_action progDynFlags) - lastErrLocationsRef } + pushLogHookM (ghciLogAction lastErrLocationsRef) when (isNothing maybe_exprs) $ do -- Only for GHCi (not runghc and ghc -e): @@ -576,8 +574,8 @@ resetLastErrorLocations = do st <- getGHCiState liftIO $ writeIORef (lastErrorLocations st) [] -ghciLogAction :: LogAction -> IORef [(FastString, Int)] -> LogAction -ghciLogAction old_log_action lastErrLocations +ghciLogAction :: IORef [(FastString, Int)] -> LogAction -> LogAction +ghciLogAction lastErrLocations old_log_action dflags flag severity srcSpan msg = do old_log_action dflags flag severity srcSpan msg case severity of @@ -3014,10 +3012,11 @@ newDynFlags :: GhciMonad m => Bool -> [String] -> m () newDynFlags interactive_only minus_opts = do let lopts = map noLoc minus_opts + logger <- getLogger idflags0 <- GHC.getInteractiveDynFlags - (idflags1, leftovers, warns) <- GHC.parseDynamicFlags idflags0 lopts + (idflags1, leftovers, warns) <- GHC.parseDynamicFlags logger idflags0 lopts - liftIO $ handleFlagWarnings idflags1 warns + liftIO $ handleFlagWarnings logger idflags1 warns when (not $ null leftovers) (throwGhcException . CmdLineError $ "Some flags have not been recognized: " @@ -3031,7 +3030,7 @@ newDynFlags interactive_only minus_opts = do dflags0 <- getDynFlags when (not interactive_only) $ do - (dflags1, _, _) <- liftIO $ GHC.parseDynamicFlags dflags0 lopts + (dflags1, _, _) <- liftIO $ GHC.parseDynamicFlags logger dflags0 lopts must_reload <- GHC.setProgramDynFlags dflags1 -- if the package flags changed, reset the context and link @@ -3168,8 +3167,7 @@ showCmd str = do , action "bindings" $ showBindings , action "linker" $ do msg <- liftIO $ Loader.showLoaderState (hsc_loader hsc_env) - dflags <- getDynFlags - liftIO $ putLogMsg dflags NoReason SevDump noSrcSpan msg + putLogMsgM NoReason SevDump noSrcSpan msg , action "breaks" $ showBkptTable , action "context" $ showContext , action "packages" $ showUnits |