Improvements to exceptions

haskell-debugger-view/src/GHC/Debugger/View/Class.hs

@@ -51,6 +51,7 @@ module GHC.Debugger.View.Class
 
 import Data.Int
 import Data.Word
+import Control.Exception
 
 -- | Custom handling of debug terms (e.g. in the variables pane, or when
 -- inspecting a lazy variable)
@@ -180,6 +181,15 @@ instance DebugView (a, b) where
     [ ("fst", VarFieldValue x)
     , ("snd", VarFieldValue y) ]
 
+instance DebugView SomeException where
+  debugValue e = simpleValue (displayException e) True
+  debugFields e@(SomeException exc) =
+    let !ctx = someExceptionContext e
+    in pure $ VarFields
+    [ ("exception", VarFieldValue exc)
+    , ("context", VarFieldValue ctx)
+    ]
+
 -- | This instance will display up to the first 50 forced elements of a list.
 instance {-# OVERLAPPABLE #-} DebugView [a] where
   debugValue [] = simpleValue "[]" False
@@ -219,4 +229,3 @@ toVarFieldsIO :: VarFields -> [(IO String, VarFieldValue)]
 toVarFieldsIO x =
   case x of
     VarFields fls -> [ (pure fl_s, b) | (fl_s, b) <- fls]
-

haskell-debugger.cabal

@@ -61,6 +61,7 @@ library
                       GHC.Debugger.Logger,
                       GHC.Debugger.Run,
                       GHC.Debugger.Stopped,
+                      GHC.Debugger.Stopped.Exception,
                       GHC.Debugger.Stopped.Variables,
 
                       GHC.Debugger.Runtime,
@@ -132,6 +133,7 @@ executable hdb
                       Development.Debug.Adapter.Stepping,
                       Development.Debug.Adapter.Stopped,
                       Development.Debug.Adapter.Evaluation,
+                      Development.Debug.Adapter.ExceptionInfo,
                       Development.Debug.Adapter.Init,
                       Development.Debug.Adapter.Interface,
                       Development.Debug.Adapter.Output,
@@ -170,7 +172,7 @@ executable hdb
         network-run >= 0.4.4,
         async >= 2.2.5 && < 2.3,
         text >= 2.1 && < 2.3,
-        dap >= 0.3.1 && < 0.4,
+        dap >= 0.4 && < 0.5,
 
         haskeline >= 0.8 && < 1,
         optparse-applicative >= 0.18 && < 0.20

haskell-debugger/GHC/Debugger.hs

@@ -9,6 +9,7 @@ import Control.Monad.IO.Class
 import GHC.Debugger.Breakpoint
 import GHC.Debugger.Run
 import GHC.Debugger.Stopped
+import GHC.Debugger.Stopped.Exception (getExceptionInfo)
 import GHC.Debugger.Monad
 import GHC.Debugger.Interface.Messages
 import GHC.Debugger.Logger
@@ -30,6 +31,7 @@ execute recorder = \case
   GetStacktrace i -> GotStacktrace <$> getStacktrace i
   GetScopes threadId frameIx -> GotScopes <$> getScopes threadId frameIx
   GetVariables threadId frameIx varRef -> GotVariables <$> getVariables threadId frameIx varRef
+  GetExceptionInfo threadId -> GotExceptionInfo <$> getExceptionInfo threadId
   DoEval exp_s -> DidEval <$> doEval exp_s
   DoContinue -> DidContinue <$> doContinue
   DoSingleStep -> DidStep <$> doSingleStep
@@ -46,4 +48,3 @@ data DebuggerLog
 instance Pretty DebuggerLog where
   pretty = \ case
     EvalLog msg -> pretty msg
-

haskell-debugger/GHC/Debugger/Interface/Messages.hs

@@ -23,7 +23,7 @@ import GHC.Debugger.Runtime.Term.Key
 data Command
 
   -- | Set a breakpoint on a given function, or module by line number
-  = SetBreakpoint { brk       :: Breakpoint 
+  = SetBreakpoint { brk       :: Breakpoint
                   , hitCount  :: Maybe Int
                   -- ^ Stop after N hits (if @isJust condition@, count down only when @eval condition == True@)
                   , condition :: Maybe String
@@ -61,6 +61,9 @@ data Command
   -- | Evaluate an expression at the current breakpoint.
   | DoEval String
 
+  -- | Get information about the current exception (if any) on a thread.
+  | GetExceptionInfo RemoteThreadId
+
   -- | Continue executing from the current breakpoint
   | DoContinue
 
@@ -196,6 +199,7 @@ data Response
   | GotStacktrace [DbgStackFrame]
   | GotScopes [ScopeInfo]
   | GotVariables (Either VarInfo [VarInfo])
+  | GotExceptionInfo ExceptionInfo
   | Aborted String
   | Initialised
 
@@ -268,10 +272,18 @@ data DbgStackFrame
     }
   deriving (Show)
 
+data ExceptionInfo = ExceptionInfo
+  { exceptionInfoTypeName     :: String
+  , exceptionInfoFullTypeName :: String
+  , exceptionInfoMessage      :: String
+  , exceptionInfoContext      :: Maybe String
+  , exceptionInfoInner        :: [ExceptionInfo]
+  }
+  deriving (Show)
+
 --------------------------------------------------------------------------------
 -- Instances
 --------------------------------------------------------------------------------
 
 instance Show GHC.InternalBreakpointId where
   show (GHC.InternalBreakpointId m ix) = "InternalBreakpointId " ++ GHC.showPprUnsafe m ++ " " ++ show ix
-

haskell-debugger/GHC/Debugger/Session/Builtin.hs

@@ -160,4 +160,3 @@ debuggerViewTextContents = stringToStringBuffer $(embedStringFile "haskell-debug
 -- | GHC.Debugger.View.ByteString
 debuggerViewByteStringContents :: StringBuffer
 debuggerViewByteStringContents = stringToStringBuffer $(embedStringFile "haskell-debugger-view/src/GHC/Debugger/View/ByteString.hs")
-

haskell-debugger/GHC/Debugger/Stopped.hs

@@ -24,6 +24,7 @@ import GHC.InfoProv
 import GHC.Utils.Outputable as Ppr
 import qualified GHC.Unit.Home.Graph as HUG
 
+import GHC.Debugger.Stopped.Exception
 import GHC.Debugger.Stopped.Variables
 import GHC.Debugger.Runtime
 import GHC.Debugger.Runtime.Thread
@@ -154,31 +155,36 @@ getStacktrace req_tid = do
     [] ->
       -- See Note [Don't crash if not stopped]
       return Nothing
-    r:_
-      | Just ss <- realSrcSpanToSourceSpan <$> srcSpanToRealSrcSpan (GHC.resumeSpan r)
-      , Just ss /= (fmap DbgStackFrame.sourceSpan (listToMaybe decoded_frames))
-          -- don't include the resume context entry if it is already at the
-          -- start of the decoded frames
-      , Just ibi <- GHC.resumeBreakpointId r
-      -> do
-        r_tid <- getRemoteThreadIdFromRemoteContext (GHC.resumeContext r)
-        if r_tid == req_tid then do
-          -- We're getting the stacktrace for the thread we're stopped at.
-          info_brks <- liftIO $ readIModBreaks hug ibi
-          let modl  = getBreakSourceMod ibi info_brks
-          modl_str  <- display modl
-          return $
-            Just DbgStackFrame
-              { name = modl_str ++ "." ++ GHC.resumeDecl r
-              , sourceSpan = ss
-              , breakId = Just ibi
-              }
-        else
-         return Nothing
-      | otherwise ->
-          -- No resume span; which should mean we're stopped on an exception.
-          -- No info for now.
-          return Nothing
+    r:_ -> do
+      let resumeSpanR = GHC.resumeSpan r
+          mRealSpan   = realSrcSpanToSourceSpan <$> srcSpanToRealSrcSpan resumeSpanR
+          firstSpan   = DbgStackFrame.sourceSpan <$> listToMaybe decoded_frames
+      r_tid <- getRemoteThreadIdFromRemoteContext (GHC.resumeContext r)
+      if r_tid /= req_tid then
+        return Nothing
+      else case GHC.resumeBreakpointId r of
+        Just ibi
+          | Just ss <- mRealSpan
+          , Just ss /= firstSpan -> do
+              -- We're getting the stacktrace for the thread we're stopped at.
+              info_brks <- liftIO $ readIModBreaks hug ibi
+              let modl  = getBreakSourceMod ibi info_brks
+              modl_str  <- display modl
+              return $
+                Just DbgStackFrame
+                  { name = modl_str ++ "." ++ GHC.resumeDecl r
+                  , sourceSpan = ss
+                  , breakId = Just ibi
+                  }
+        _ -> do
+          mExcSpan <- exceptionSourceSpanFromContext
+          case mExcSpan of
+            Just sourceSpan ->  return $ Just DbgStackFrame
+                                  { name = GHC.resumeDecl r
+                                  , sourceSpan
+                                  , breakId = Nothing
+                                  }
+            Nothing -> return Nothing
   return (maybe id (:) head_frame $ decoded_frames)
 
 --------------------------------------------------------------------------------
@@ -191,6 +197,12 @@ getScopes threadId frameIx = do
   frames <- getStacktrace threadId
   let frame = frames !! frameIx
   let sourceSpan = DbgStackFrame.sourceSpan frame
+      localsScope = ScopeInfo
+        { kind = LocalVariablesScope
+        , expensive = False
+        , numVars = Nothing
+        , sourceSpan
+        }
   if
     | frameIx < length frames
     , Just ibi <- DbgStackFrame.breakId frame
@@ -204,11 +216,7 @@ getScopes threadId frameIx = do
       in_mod   <- getTopEnv brk_modl
       imported <- getTopImported brk_modl
       return
-        [ ScopeInfo { kind = LocalVariablesScope
-                    , expensive = False
-                    , numVars = Nothing
-                    , sourceSpan
-                    }
+        [ localsScope
         , ScopeInfo { kind = ModuleVariablesScope
                     , expensive = True
                     , numVars = Just (sizeUFM in_mod)
@@ -221,7 +229,7 @@ getScopes threadId frameIx = do
                     }
         ]
     | otherwise ->
-      return []
+      return [localsScope]
 
 --------------------------------------------------------------------------------
 -- * Variables