Show breakpoint locations of breakpoints which were ignored during :force (#2950)

GHCi is split up into 2 major parts: The user-interface (UI)
and the byte-code interpreter. With `-fexternal-interpreter`
they even run in different processes. Communication between
the UI and the Interpreter (called `iserv`) is done using
messages over a pipe. This is called `Remote GHCI` and
explained in the Note [Remote GHCi] in `compiler/ghci/GHCi.hs`.

To process a `:force` command the UI sends a `Seq` message
to the `iserv` process. Then `iserv` does the effective
evaluation of the value. When during this process a breakpoint
is hit, the `iserv` process has no additional information to
enhance the `Ignoring breakpoint` output with the breakpoint
location.

To be able to print additional breakpoint information,
there are 2 possible implementation choices:
1. Store the needed information in the `iserv` process.
2. Print the `Ignoring breakpoint` from the UI process.

For option 1 we need to store the breakpoint info redundantely
in 2 places and this is bad. Therfore option 2 was implemented
in this MR:
- The user enters a `force` command
- The UI sends  a `Seq` message to the `iserv` process.
- If processing of the `Seq` message hits a breakpoint,
  the `iserv` process returns control to the UI process.
- The UI looks up the source location of the breakpoint,
  and prints the enhanced `Ignoring breakpoint` output.
- The UI sends a `ResumeSeq` message to the `iserv` process,
  to continue forcing.

2 files changed, 41 insertions, 2 deletions

diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs
index 70c532fc94..7e96601b99 100644
--- a/libraries/ghci/GHCi/Message.hs
+++ b/libraries/ghci/GHCi/Message.hs
@@ -215,7 +215,12 @@ data Message a where
   -- | Evaluate something. This is used to support :force in GHCi.
   Seq
     :: HValueRef
-    -> Message (EvalResult ())
+    -> Message (EvalStatus ())
+
+  -- | Resume forcing a free variable in a breakpoint (#2950)
+  ResumeSeq
+    :: RemoteRef (ResumeContext ())
+    -> Message (EvalStatus ())
 
 deriving instance Show (Message a)
 
@@ -492,6 +497,7 @@ getMessage = do
       35 -> Msg <$> (GetClosure <$> get)
       36 -> Msg <$> (Seq <$> get)
       37 -> Msg <$> return RtsRevertCAFs
+      38 -> Msg <$> (ResumeSeq <$> get)
       _  -> error $ "Unknown Message code " ++ (show b)
 
 putMessage :: Message a -> Put
@@ -534,6 +540,7 @@ putMessage m = case m of
   GetClosure a                -> putWord8 35 >> put a
   Seq a                       -> putWord8 36 >> put a
   RtsRevertCAFs               -> putWord8 37
+  ResumeSeq a                 -> putWord8 38 >> put a
 
 -- -----------------------------------------------------------------------------
 -- Reading/writing messages
diff --git a/libraries/ghci/GHCi/Run.hs b/libraries/ghci/GHCi/Run.hs
index a931e620cc..37dc7f2f48 100644
--- a/libraries/ghci/GHCi/Run.hs
+++ b/libraries/ghci/GHCi/Run.hs
@@ -95,7 +95,8 @@ run m = case m of
   GetClosure ref -> do
     clos <- getClosureData =<< localRef ref
     mapM (\(Box x) -> mkRemoteRef (HValue x)) clos
-  Seq ref -> tryEval (void $ evaluate =<< localRef ref)
+  Seq ref -> doSeq ref
+  ResumeSeq ref -> resumeSeq ref
   _other -> error "GHCi.Run.run"
 
 evalStmt :: EvalOpts -> EvalExpr HValueRef -> IO (EvalStatus [HValueRef])
@@ -130,6 +131,37 @@ evalStringToString r str = do
     r <- (unsafeCoerce io :: String -> IO String) str
     evaluate (force r)
 
+-- | Process the Seq message to force a value.                       #2950
+-- If during this processing a breakpoint is hit, return
+-- an EvalBreak value in the EvalStatus to the UI process,
+-- otherwise return an EvalComplete.
+-- The UI process has more and therefore also can show more
+-- information about the breakpoint than the current iserv
+-- process.
+doSeq :: RemoteRef a -> IO (EvalStatus ())
+doSeq ref = do
+    sandboxIO evalOptsSeq $ do
+      _ <- (void $ evaluate =<< localRef ref)
+      return ()
+
+-- | Process a ResumeSeq message. Continue the :force processing     #2950
+-- after a breakpoint.
+resumeSeq :: RemoteRef (ResumeContext ()) -> IO (EvalStatus ())
+resumeSeq hvref = do
+    ResumeContext{..} <- localRef hvref
+    withBreakAction evalOptsSeq resumeBreakMVar resumeStatusMVar $
+      mask_ $ do
+        putMVar resumeBreakMVar () -- this awakens the stopped thread...
+        redirectInterrupts resumeThreadId $ takeMVar resumeStatusMVar
+
+evalOptsSeq :: EvalOpts
+evalOptsSeq = EvalOpts
+              { useSandboxThread = True
+              , singleStep = False
+              , breakOnException = False
+              , breakOnError = False
+              }
+
 -- When running a computation, we redirect ^C exceptions to the running
 -- thread.  ToDo: we might want a way to continue even if the target
 -- thread doesn't die when it receives the exception... "this thread