[commit: ghc] wip/D4533: Don't overwrite the set log_action when using --interactive (bc26799)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/D4533
Link       : http://ghc.haskell.org/trac/ghc/changeset/bc26799166d65ead7bbd7303454314c07e750b22/ghc

>---------------------------------------------------------------

commit bc26799166d65ead7bbd7303454314c07e750b22
Author: Matthew Pickering <matthewtpickering at gmail.com>
Date:   Sun Jan 20 20:58:01 2019 -0500

    Don't overwrite the set log_action when using --interactive
    
    -ddump-json didn't work with --interactive as --interactive overwrote
    the log_action in terms of defaultLogAction.
    
    Reviewers: bgamari
    
    Subscribers: rwbarton, thomie, carter
    
    GHC Trac Issues: #14078
    
    Differential Revision: https://phabricator.haskell.org/D4533


>---------------------------------------------------------------

bc26799166d65ead7bbd7303454314c07e750b22
 ghc/GHCi/UI.hs | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 10ca511..8d20134 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -445,7 +445,8 @@ interactiveUI config srcs maybe_exprs = do
    lastErrLocationsRef <- liftIO $ newIORef []
    progDynFlags <- GHC.getProgramDynFlags
    _ <- GHC.setProgramDynFlags $
-      progDynFlags { log_action = ghciLogAction lastErrLocationsRef }
+      progDynFlags { log_action = ghciLogAction (log_action progDynFlags)
+                                                lastErrLocationsRef }
 
    when (isNothing maybe_exprs) $ do
         -- Only for GHCi (not runghc and ghc -e):
@@ -536,9 +537,10 @@ resetLastErrorLocations = do
     st <- getGHCiState
     liftIO $ writeIORef (lastErrorLocations st) []
 
-ghciLogAction :: IORef [(FastString, Int)] ->  LogAction
-ghciLogAction lastErrLocations dflags flag severity srcSpan style msg = do
-    defaultLogAction dflags flag severity srcSpan style msg
+ghciLogAction :: LogAction -> IORef [(FastString, Int)] ->  LogAction
+ghciLogAction old_log_action lastErrLocations
+              dflags flag severity srcSpan style msg = do
+    old_log_action dflags flag severity srcSpan style msg
     case severity of
         SevError -> case srcSpan of
             RealSrcSpan rsp -> modifyIORef lastErrLocations