{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultilineStrings #-}

-- | Helpers used when the debugger is stopped due to an exception.
-- These helpers execute code on the remote process which teach us information
-- about the exception we are stopped at.
module GHC.Debugger.Stopped.Exception
  ( getExceptionInfo
  , defaultExceptionInfo
  ) where

import Data.Maybe

import GHC

import GHC.Debugger.Monad
import GHC.Debugger.Interface.Messages
  ( ExceptionInfo(..)
  , RemoteThreadId(..)
  )
import GHC.Debugger.Runtime.Thread
import GHCi.RemoteTypes
#if MIN_VERSION_ghc(9,14,2)
import qualified GHC.Debugger.Runtime.Interpreter as Debuggee
#else
import qualified GHC.Debugger.Runtime.Interpreter.Legacy as Debuggee
#endif
import Control.Exception (SomeException)

-- | Retrieve structured exception information for the requested thread when
-- the debugger is currently stopped on an exception.
getExceptionInfo :: RemoteThreadId -> Debugger ExceptionInfo
getExceptionInfo :: RemoteThreadId -> Debugger ExceptionInfo
getExceptionInfo RemoteThreadId
req_tid = Debugger [Resume]
forall (m :: * -> *). GhcMonad m => m [Resume]
GHC.getResumeContext Debugger [Resume]
-> ([Resume] -> Debugger ExceptionInfo) -> Debugger ExceptionInfo
forall a b. Debugger a -> (a -> Debugger b) -> Debugger b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  [] -> ExceptionInfo -> Debugger ExceptionInfo
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return ExceptionInfo
defaultExceptionInfo
  Resume
r:[Resume]
_ -> do
    r_tid <- ForeignRef (ResumeContext [HValueRef]) -> Debugger RemoteThreadId
getRemoteThreadIdFromRemoteContext (Resume -> ForeignRef (ResumeContext [HValueRef])
GHC.resumeContext Resume
r)
    case (r_tid == req_tid, GHC.resumeBreakpointId r) of
      (Bool
True, Maybe InternalBreakpointId
Nothing) -> do
        let excRef :: ForeignHValue
excRef = Resume -> ForeignHValue
resumeApStack Resume
r
        ExceptionInfo -> Maybe ExceptionInfo -> ExceptionInfo
forall a. a -> Maybe a -> a
fromMaybe ExceptionInfo
defaultExceptionInfo (Maybe ExceptionInfo -> ExceptionInfo)
-> Debugger (Maybe ExceptionInfo) -> Debugger ExceptionInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForeignRef SomeException -> Debugger (Maybe ExceptionInfo)
exceptionInfoFromContext (ForeignHValue -> ForeignRef SomeException
forall a b. ForeignRef a -> ForeignRef b
castForeignRef ForeignHValue
excRef)
      (Bool, Maybe InternalBreakpointId)
_ -> ExceptionInfo -> Debugger ExceptionInfo
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return ExceptionInfo
defaultExceptionInfo

-- | Evaluate helper code inside the debuggee that turns the exception context
-- into our 'ExceptionInfo' structure.
exceptionInfoFromContext :: ForeignRef SomeException -> Debugger (Maybe ExceptionInfo)
exceptionInfoFromContext :: ForeignRef SomeException -> Debugger (Maybe ExceptionInfo)
exceptionInfoFromContext ForeignRef SomeException
excRef = do
#if MIN_VERSION_ghc(9,15,0)
  Just <$> Debuggee.collectExceptionInfo excRef
#else
  ForeignRef SomeException -> Debugger (Maybe ExceptionInfo)
Debuggee.collectExceptionInfo ForeignRef SomeException
excRef
#endif

-- | Placeholder exception info returned when the context could not be
-- inspected.
defaultExceptionInfo :: ExceptionInfo
defaultExceptionInfo :: ExceptionInfo
defaultExceptionInfo = ExceptionInfo
  { exceptionInfoTypeName :: String
exceptionInfoTypeName = String
"Exception"
  , exceptionInfoFullTypeName :: String
exceptionInfoFullTypeName = String
"Exception"
  , exceptionInfoMessage :: String
exceptionInfoMessage = String
"Exception information not available"
  , exceptionInfoContext :: Maybe String
exceptionInfoContext = Maybe String
forall a. Maybe a
Nothing
  , exceptionInfoSourceSpan :: Maybe SourceSpan
exceptionInfoSourceSpan = Maybe SourceSpan
forall a. Maybe a
Nothing
  , exceptionInfoInner :: [ExceptionInfo]
exceptionInfoInner = []
  }