{-# LANGUAGE CPP, NamedFieldPuns, TupleSections, LambdaCase,
   DuplicateRecordFields, RecordWildCards, TupleSections, ViewPatterns,
   TypeApplications, ScopedTypeVariables, BangPatterns #-}
module GHC.Debugger.Stopped where

import Data.IORef
import Control.Monad.Reader
import Control.Monad.IO.Class

import GHC
import GHC.Types.Unique.FM
#if MIN_VERSION_ghc(9,13,20250417)
import GHC.Types.Name.Occurrence (sizeOccEnv)
#endif
import GHC.Types.Name.Reader
import GHC.Unit.Home.ModInfo
import GHC.Unit.Module.ModDetails
import GHC.Types.TypeEnv
import GHC.Data.Maybe (expectJust)
import GHC.Driver.Env as GHC
import GHC.Runtime.Debugger.Breakpoints as GHC
import GHC.Runtime.Eval
import GHC.Types.SrcLoc
import qualified GHC.Runtime.Heap.Inspect as GHCI
import qualified GHC.Unit.Home.Graph as HUG

import GHC.Debugger.Stopped.Variables
import GHC.Debugger.Runtime
import GHC.Debugger.Runtime.Term.Cache
import GHC.Debugger.Monad
import GHC.Debugger.Interface.Messages
import GHC.Debugger.Utils

{-
Note [Don't crash if not stopped]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Requests such as `stacktrace`, `scopes`, or `variables` may end up
coming after the execution of a program has terminated. For instance,
consider this interleaving:

1. SENT Stopped event         <-- we're stopped
2. RECEIVED StackTrace req    <-- client issues after stopped event
3. RECEIVED Next req          <-- user clicks step-next
4. <program execution resumes and fails>
5. SENT Terminate event       <-- execution failed and we report it to exit cleanly
6. RECEIVED Scopes req        <-- happens as a sequence of 2 that wasn't canceled
7. <used to crash! because we're no longer at a breakpoint>

Now, we simply returned empty responses when these requests come in
while we're no longer at a breakpoint. The client will soon come to a halt
because of the termination event we sent.
-}

--------------------------------------------------------------------------------
-- * Stack trace
--------------------------------------------------------------------------------

-- | Get the stack frames at the point we're stopped at
getStacktrace :: Debugger [StackFrame]
getStacktrace :: Debugger [StackFrame]
getStacktrace = Debugger [Resume]
forall (m :: * -> *). GhcMonad m => m [Resume]
GHC.getResumeContext Debugger [Resume]
-> ([Resume] -> Debugger [StackFrame]) -> Debugger [StackFrame]
forall a b. Debugger a -> (a -> Debugger b) -> Debugger b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  [] ->
    -- See Note [Don't crash if not stopped]
    [StackFrame] -> Debugger [StackFrame]
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  Resume
r:[Resume]
_
    | Just RealSrcSpan
ss <- SrcSpan -> Maybe RealSrcSpan
srcSpanToRealSrcSpan (Resume -> SrcSpan
GHC.resumeSpan Resume
r)
    -> [StackFrame] -> Debugger [StackFrame]
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return
        [ StackFrame
          { name :: String
name = Resume -> String
GHC.resumeDecl Resume
r
          , sourceSpan :: SourceSpan
sourceSpan = RealSrcSpan -> SourceSpan
realSrcSpanToSourceSpan RealSrcSpan
ss
          }
        ]
    | Bool
otherwise ->
        -- No resume span; which should mean we're stopped on an exception.
        -- No info for now.
        [StackFrame] -> Debugger [StackFrame]
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return []

--------------------------------------------------------------------------------
-- * Scopes
--------------------------------------------------------------------------------

-- | Get the stack frames at the point we're stopped at
getScopes :: Debugger [ScopeInfo]
getScopes :: Debugger [ScopeInfo]
getScopes = Debugger (Maybe SrcSpan)
forall (m :: * -> *). GhcMonad m => m (Maybe SrcSpan)
GHC.getCurrentBreakSpan Debugger (Maybe SrcSpan)
-> (Maybe SrcSpan -> Debugger [ScopeInfo]) -> Debugger [ScopeInfo]
forall a b. Debugger a -> (a -> Debugger b) -> Debugger b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Maybe SrcSpan
Nothing ->
    -- See Note [Don't crash if not stopped]
    [ScopeInfo] -> Debugger [ScopeInfo]
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  Just SrcSpan
span'
    | Just RealSrcSpan
rss <- SrcSpan -> Maybe RealSrcSpan
srcSpanToRealSrcSpan SrcSpan
span'
    , let sourceSpan :: SourceSpan
sourceSpan = RealSrcSpan -> SourceSpan
realSrcSpanToSourceSpan RealSrcSpan
rss
    -> do
      -- It is /very important/ to report a number of variables (numVars) for
      -- larger scopes. If we just say "Nothing", then all variables of all
      -- scopes will be fetched at every stopped event.
      curr_modl <- Maybe Module -> Module
forall a. HasCallStack => Maybe a -> a
expectJust (Maybe Module -> Module)
-> Debugger (Maybe Module) -> Debugger Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Debugger (Maybe Module)
forall (m :: * -> *). GhcMonad m => m (Maybe Module)
getCurrentBreakModule
      in_mod <- getTopEnv curr_modl
      imported <- getTopImported curr_modl
      return
        [ ScopeInfo { kind = LocalVariablesScope
                    , expensive = False
                    , numVars = Nothing
                    , sourceSpan
                    }
        , ScopeInfo { kind = ModuleVariablesScope
                    , expensive = True
                    , numVars = Just (sizeUFM in_mod)
                    , sourceSpan
                    }
        , ScopeInfo { kind = GlobalVariablesScope
                    , expensive = True
#if MIN_VERSION_ghc(9,13,20250417)
                    , numVars = Just (sizeOccEnv imported)
#else
                    , numVars = Nothing
#endif
                    , sourceSpan
                    }
        ]
    | Bool
otherwise ->
      -- No resume span; which should mean we're stopped on an exception
      -- TODO: Use exception context to create source span, or at least
      -- return the source span null to have Scopes at least.
      [ScopeInfo] -> Debugger [ScopeInfo]
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return []

--------------------------------------------------------------------------------
-- * Variables
--------------------------------------------------------------------------------
-- Note [Variables Requests]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~
-- We can receive a Variables request for three different reasons
--
-- 1. To get the variables in a certain scope
-- 2. To inspect the value of a lazy variable
-- 3. To expand the structure of a variable
--
-- The replies are, respectively:
--
-- (VARR)
-- (a) All the variables in the request scope
-- (b) ONLY the variable requested
-- (c) The fields of the variable requested but NOT the original variable

-- | Get variables using a variable/variables reference
--
-- If the Variable Request ends up being case (VARR)(b), then we signal the
-- request forced the variable and return @Left varInfo@. Otherwise, @Right vis@.
--
-- See Note [Variables Requests]
getVariables :: VariableReference -> Debugger (Either VarInfo [VarInfo])
getVariables :: VariableReference -> Debugger (Either VarInfo [VarInfo])
getVariables VariableReference
vk = do
  hsc_env <- Debugger HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
  GHC.getResumeContext >>= \case
    [] ->
      -- See Note [Don't crash if not stopped]
      Either VarInfo [VarInfo] -> Debugger (Either VarInfo [VarInfo])
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return ([VarInfo] -> Either VarInfo [VarInfo]
forall a b. b -> Either a b
Right [])
    Resume
r:[Resume]
_ -> case VariableReference
vk of

      -- Only `seq` the variable when inspecting a specific one (`SpecificVariable`)
      -- (VARR)(b,c)
      SpecificVariable Int
i -> do
        Int -> Debugger (Maybe TermKey)
lookupVarByReference Int
i Debugger (Maybe TermKey)
-> (Maybe TermKey -> Debugger (Either VarInfo [VarInfo]))
-> Debugger (Either VarInfo [VarInfo])
forall a b. Debugger a -> (a -> Debugger b) -> Debugger b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe TermKey
Nothing -> do
            -- lookupVarByReference failed.
            -- This may happen if, in a race, we change scope while asking for
            -- variables of the previous scope.
            -- Somewhat similar to the race in Note [Don't crash if not stopped]
            Either VarInfo [VarInfo] -> Debugger (Either VarInfo [VarInfo])
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return ([VarInfo] -> Either VarInfo [VarInfo]
forall a b. b -> Either a b
Right [])
          Just TermKey
key -> do
            term <- TermKey -> Debugger Term
obtainTerm TermKey
key

            case term of

              -- (VARR)(b)
              Suspension{} -> do

                -- Original Term was a suspension:
                -- It is a "lazy" DAP variable: our reply can ONLY include
                -- this single variable.

                term' <- TermKey -> Term -> Debugger Term
forceTerm TermKey
key Term
term

                vi <- termToVarInfo key term'

                return (Left vi)

              -- (VARR)(c)
              Term
_ -> [VarInfo] -> Either VarInfo [VarInfo]
forall a b. b -> Either a b
Right ([VarInfo] -> Either VarInfo [VarInfo])
-> Debugger [VarInfo] -> Debugger (Either VarInfo [VarInfo])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do

                -- Original Term was already something other than a Suspension;
                -- Meaning the @SpecificVariable@ request means to inspect the structure.
                -- Return ONLY the fields

                TermKey -> Term -> Debugger VarFields
termVarFields TermKey
key Term
term Debugger VarFields
-> (VarFields -> Debugger [VarInfo]) -> Debugger [VarInfo]
forall a b. Debugger a -> (a -> Debugger b) -> Debugger b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  VarFields
NoFields -> [VarInfo] -> Debugger [VarInfo]
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                  LabeledFields [VarInfo]
xs -> [VarInfo] -> Debugger [VarInfo]
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return [VarInfo]
xs
                  IndexedFields [VarInfo]
xs -> [VarInfo] -> Debugger [VarInfo]
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return [VarInfo]
xs


      -- (VARR)(a) from here onwards

      VariableReference
LocalVariables -> ([VarInfo] -> Either VarInfo [VarInfo])
-> Debugger [VarInfo] -> Debugger (Either VarInfo [VarInfo])
forall a b. (a -> b) -> Debugger a -> Debugger b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [VarInfo] -> Either VarInfo [VarInfo]
forall a b. b -> Either a b
Right (Debugger [VarInfo] -> Debugger (Either VarInfo [VarInfo]))
-> Debugger [VarInfo] -> Debugger (Either VarInfo [VarInfo])
forall a b. (a -> b) -> a -> b
$
        -- bindLocalsAtBreakpoint hsc_env (GHC.resumeApStack r) (GHC.resumeSpan r) (GHC.resumeBreakpointId r)
        (TyThing -> Debugger VarInfo) -> [TyThing] -> Debugger [VarInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TyThing -> Debugger VarInfo
tyThingToVarInfo ([TyThing] -> Debugger [VarInfo])
-> Debugger [TyThing] -> Debugger [VarInfo]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Debugger [TyThing]
forall (m :: * -> *). GhcMonad m => m [TyThing]
GHC.getBindings

      VariableReference
ModuleVariables -> [VarInfo] -> Either VarInfo [VarInfo]
forall a b. b -> Either a b
Right ([VarInfo] -> Either VarInfo [VarInfo])
-> Debugger [VarInfo] -> Debugger (Either VarInfo [VarInfo])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        case InternalBreakpointId -> Module
ibi_tick_mod (InternalBreakpointId -> Module)
-> Maybe InternalBreakpointId -> Maybe Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Resume -> Maybe InternalBreakpointId
GHC.resumeBreakpointId Resume
r of
          Maybe Module
Nothing -> [VarInfo] -> Debugger [VarInfo]
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return []
          Just Module
curr_modl -> do
            things <- TypeEnv -> [TyThing]
typeEnvElts (TypeEnv -> [TyThing]) -> Debugger TypeEnv -> Debugger [TyThing]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Module -> Debugger TypeEnv
getTopEnv Module
curr_modl
            mapM (\TyThing
tt -> do
              nameStr <- Name -> Debugger String
forall a. Outputable a => a -> Debugger String
display (TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
tt)
              vi <- tyThingToVarInfo tt
              return vi{varName = nameStr}) things

      VariableReference
GlobalVariables -> [VarInfo] -> Either VarInfo [VarInfo]
forall a b. b -> Either a b
Right ([VarInfo] -> Either VarInfo [VarInfo])
-> Debugger [VarInfo] -> Debugger (Either VarInfo [VarInfo])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        case InternalBreakpointId -> Module
ibi_tick_mod (InternalBreakpointId -> Module)
-> Maybe InternalBreakpointId -> Maybe Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Resume -> Maybe InternalBreakpointId
GHC.resumeBreakpointId Resume
r of
          Maybe Module
Nothing -> [VarInfo] -> Debugger [VarInfo]
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return []
          Just Module
curr_modl -> do
            names <- (GlobalRdrEltX GREInfo -> Name)
-> [GlobalRdrEltX GREInfo] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrEltX GREInfo -> Name
forall info. GlobalRdrEltX info -> Name
greName ([GlobalRdrEltX GREInfo] -> [Name])
-> (GlobalRdrEnv -> [GlobalRdrEltX GREInfo])
-> GlobalRdrEnv
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrEnv -> [GlobalRdrEltX GREInfo]
forall info. GlobalRdrEnvX info -> [GlobalRdrEltX info]
globalRdrEnvElts (GlobalRdrEnv -> [Name])
-> Debugger GlobalRdrEnv -> Debugger [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Module -> Debugger GlobalRdrEnv
getTopImported Module
curr_modl
            mapM (\Name
n-> do
              nameStr <- Name -> Debugger String
forall a. Outputable a => a -> Debugger String
display Name
n
              liftIO (GHC.lookupType hsc_env n) >>= \case
                Maybe TyThing
Nothing ->
                  VarInfo -> Debugger VarInfo
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return VarInfo
                    { varName :: String
varName = String
nameStr
                    , varType :: String
varType = String
""
                    , varValue :: String
varValue = String
""
                    , isThunk :: Bool
isThunk = Bool
False
                    , varRef :: VariableReference
varRef = VariableReference
NoVariables
                    }
                Just TyThing
tt -> do
                  vi <- TyThing -> Debugger VarInfo
tyThingToVarInfo TyThing
tt
                  return vi{varName = nameStr}
              ) names

      VariableReference
NoVariables -> [VarInfo] -> Either VarInfo [VarInfo]
forall a b. b -> Either a b
Right ([VarInfo] -> Either VarInfo [VarInfo])
-> Debugger [VarInfo] -> Debugger (Either VarInfo [VarInfo])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        [VarInfo] -> Debugger [VarInfo]
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return []

--------------------------------------------------------------------------------
-- Inspect
--------------------------------------------------------------------------------

-- | All top-level things from a module, including unexported ones.
getTopEnv :: Module -> Debugger TypeEnv
getTopEnv :: Module -> Debugger TypeEnv
getTopEnv Module
modl = do
  hsc_env <- Debugger HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
  liftIO $ HUG.lookupHugByModule modl (hsc_HUG hsc_env) >>= \case
    Maybe HomeModInfo
Nothing -> TypeEnv -> IO TypeEnv
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeEnv
emptyTypeEnv
    Just HomeModInfo
      { hm_details :: HomeModInfo -> ModDetails
hm_details = ModDetails
        { md_types :: ModDetails -> TypeEnv
md_types = TypeEnv
things
        }
      } -> TypeEnv -> IO TypeEnv
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeEnv
things

-- | All bindings imported at a given module
getTopImported :: Module -> Debugger GlobalRdrEnv
getTopImported :: Module -> Debugger GlobalRdrEnv
getTopImported Module
modl = do
  hsc_env <- Debugger HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
  liftIO $ HUG.lookupHugByModule modl (hsc_HUG hsc_env) >>= \case
    Maybe HomeModInfo
Nothing -> GlobalRdrEnv -> IO GlobalRdrEnv
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GlobalRdrEnv
forall info. GlobalRdrEnvX info
emptyGlobalRdrEnv
#if MIN_VERSION_ghc(9,13,20250417)
    Just hmi -> mkTopLevImportedEnv hsc_env hmi
#else
    Just HomeModInfo
hmi -> GlobalRdrEnv -> IO GlobalRdrEnv
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GlobalRdrEnv
forall info. GlobalRdrEnvX info
emptyGlobalRdrEnv
#endif