diff --git a/haskell-debugger/GHC/Debugger/Stopped.hs b/haskell-debugger/GHC/Debugger/Stopped.hs index cc097052..36da4225 100644 --- a/haskell-debugger/GHC/Debugger/Stopped.hs +++ b/haskell-debugger/GHC/Debugger/Stopped.hs @@ -63,46 +63,18 @@ because of the termination event we sent. getThreads :: Debugger [DebuggeeThread] getThreads = do - -- TODO: we want something more like 'listThreads', but ensure that we only - -- report the threads of the debuggee (and not the debugger, if they - -- are the same process). Perhaps the solution is to not allow them to be in - -- the same process, in which case 'listThreads' would be correct as is by - -- construction. - -- - -- For now, we approximate by just listing out the ThreadsMap, under the - -- assumption the debugger client will only care about threads we've already - -- stopped at (which are the only ones we've inserted in the threads map), - -- but for full multi threaded debugging we need the listThreads. - -- - -- tmap <- liftIO . readIORef =<< asks threadMap - -- let (t_ids, remote_refs) = unzip (threadMapToList tmap) - -- - -- Oh, try the listThreads just for fun. (t_ids, remote_refs) <- unzip <$> listAllLiveRemoteThreads t_labels <- getRemoteThreadsLabels remote_refs let - _mkDebuggeeThread tid tlbl + mkDebuggeeThread tid tlbl = DebuggeeThread { tId = tid , tName = tlbl } - _all_threads - = zipWith _mkDebuggeeThread t_ids t_labels + all_threads + = zipWith mkDebuggeeThread t_ids t_labels - -- TODO: We ignore _all_threads and report only the main execution thread for now. - -- See #138 for progress on Multi-threaded debugging. - GHC.getResumeContext >>= \case - [] -> - -- See Note [Don't crash if not stopped] - return [] - r:_ -> do - r_tid <- getRemoteThreadIdFromRemoteContext (GHC.resumeContext r) - return - [ DebuggeeThread - { tId = r_tid - , tName = Just "Main Thread" - } - ] + return all_threads -------------------------------------------------------------------------------- -- * Stack trace diff --git a/hdb/Development/Debug/Adapter/Evaluation.hs b/hdb/Development/Debug/Adapter/Evaluation.hs index 22b42c72..daf75ff3 100644 --- a/hdb/Development/Debug/Adapter/Evaluation.hs +++ b/hdb/Development/Debug/Adapter/Evaluation.hs @@ -109,7 +109,7 @@ handleEvalResult stepping er = case er of EvalStopped {breakId = Nothing, breakThread} -> sendStoppedEvent defaultStoppedEvent { - stoppedEventAllThreadsStopped = True + stoppedEventAllThreadsStopped = False , stoppedEventReason = StoppedEventReasonException , stoppedEventHitBreakpointIds = [] , stoppedEventThreadId = Just $ remoteThreadIntRef breakThread @@ -118,7 +118,7 @@ handleEvalResult stepping er = case er of DAS{breakpointMap} <- getDebugSession sendStoppedEvent defaultStoppedEvent { - stoppedEventAllThreadsStopped = True + stoppedEventAllThreadsStopped = False -- could be more precise here by saying "function breakpoint" rather than always "breakpoint" , stoppedEventReason = if stepping then StoppedEventReasonStep diff --git a/hdb/Main.hs b/hdb/Main.hs index 74801c22..4e3af9f0 100644 --- a/hdb/Main.hs +++ b/hdb/Main.hs @@ -185,7 +185,7 @@ getConfig port = do , supportsSteppingGranularity = False , supportsInstructionBreakpoints = False , supportsExceptionFilterOptions = False - , supportsSingleThreadExecutionRequests = False + , supportsSingleThreadExecutionRequests = True } ServerConfig <$> do fromMaybe hostDefault <$> lookupEnv "DAP_HOST"