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

import Control.Monad
import Control.Monad.Reader
import Data.IORef
import qualified Data.List as L

import GHC
import GHC.Types.Unique.FM
import GHC.Types.Name.Occurrence (sizeOccEnv)
import GHC.ByteCode.Breakpoints
import GHC.Types.Name.Reader
import GHC.Unit.Home.ModInfo
import GHC.Unit.Module.ModDetails
import GHC.Types.TypeEnv
import GHC.Data.Maybe
import GHC.Driver.Env as GHC
import GHC.Runtime.Eval
import GHC.Types.SrcLoc
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.Frames
import GHC.Debugger.Stopped.Variables
import GHC.Debugger.Runtime
import GHC.Debugger.Runtime.Thread
import GHC.Debugger.Runtime.Thread.Stack
import GHC.Debugger.Runtime.Thread.Map
import GHC.Debugger.Monad
import GHC.Debugger.Interface.Messages
import qualified GHC.Debugger.Interface.Messages as DbgStackFrame (DbgStackFrame(..))
import GHC.Debugger.Utils
import qualified Colog.Core as Logger
import System.Directory (getCurrentDirectory)

{-
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.
-}

--------------------------------------------------------------------------------
-- * Threads
--------------------------------------------------------------------------------

getThreads :: Debugger [DebuggeeThread]
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, t_infos) <- [(RemoteThreadId, ThreadInfo ForeignRef)]
-> ([RemoteThreadId], [ThreadInfo ForeignRef])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(RemoteThreadId, ThreadInfo ForeignRef)]
 -> ([RemoteThreadId], [ThreadInfo ForeignRef]))
-> Debugger [(RemoteThreadId, ThreadInfo ForeignRef)]
-> Debugger ([RemoteThreadId], [ThreadInfo ForeignRef])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Debugger [(RemoteThreadId, ThreadInfo ForeignRef)]
listAllLiveRemoteThreads
  let
    _mkDebuggeeThread RemoteThreadId
tid r
tinfo
      = DebuggeeThread
        { tId :: RemoteThreadId
tId = RemoteThreadId
tid
        , tName :: Maybe String
tName = r
tinfo.threadInfoLabel
        }
    _all_threads
      = (RemoteThreadId -> ThreadInfo ForeignRef -> DebuggeeThread)
-> [RemoteThreadId] -> [ThreadInfo ForeignRef] -> [DebuggeeThread]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith RemoteThreadId -> ThreadInfo ForeignRef -> DebuggeeThread
forall {r}.
HasField "threadInfoLabel" r (Maybe String) =>
RemoteThreadId -> r -> DebuggeeThread
_mkDebuggeeThread [RemoteThreadId]
t_ids [ThreadInfo ForeignRef]
t_infos

  -- 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]
      [DebuggeeThread] -> Debugger [DebuggeeThread]
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Resume
r:[Resume]
_ -> do
      r_tid <- ForeignRef (ResumeContext [HValueRef]) -> Debugger RemoteThreadId
getRemoteThreadIdFromRemoteContext (Resume -> ForeignRef (ResumeContext [HValueRef])
GHC.resumeContext Resume
r)
      return
        [ DebuggeeThread
          { tId = r_tid
          , tName = Just "Main Thread"
          }
        ]

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

-- | Get the stack frames at the point we're stopped at
getStacktrace :: RemoteThreadId -> Debugger [DbgStackFrame]
getStacktrace :: RemoteThreadId -> Debugger [DbgStackFrame]
getStacktrace RemoteThreadId
req_tid = do

  tm <- IO ThreadMap -> Debugger ThreadMap
forall a. IO a -> Debugger a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadMap -> Debugger ThreadMap)
-> (IORef ThreadMap -> IO ThreadMap)
-> IORef ThreadMap
-> Debugger ThreadMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef ThreadMap -> IO ThreadMap
forall a. IORef a -> IO a
readIORef (IORef ThreadMap -> Debugger ThreadMap)
-> Debugger (IORef ThreadMap) -> Debugger ThreadMap
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (DebuggerState -> IORef ThreadMap) -> Debugger (IORef ThreadMap)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DebuggerState -> IORef ThreadMap
threadMap
  let m_f_tid = Int -> ThreadMap -> Maybe (ForeignRef ThreadId)
lookupThreadMap (RemoteThreadId -> Int
remoteThreadIntRef RemoteThreadId
req_tid) ThreadMap
tm

  hsc_env <- getSession
  let hug = HscEnv -> HomeUnitGraph
hsc_HUG HscEnv
hsc_env
  cwd <- mkAbsolute <$> liftIO getCurrentDirectory
  decoded_frames <- catMaybes <$> case m_f_tid of
    Maybe (ForeignRef ThreadId)
Nothing -> [Maybe DbgStackFrame] -> Debugger [Maybe DbgStackFrame]
forall a. a -> Debugger a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just ForeignRef ThreadId
f_tid -> do
      -- Try decoding a stack with interpreter continuation frames (RetBCOs)
      -- and use the BRK_FUN src locations.
      stack_frames <- ForeignRef ThreadId -> Debugger [StackFrameInfo ForeignRef]
getRemoteThreadStackCopy ForeignRef ThreadId
f_tid
      forM stack_frames $ \case
        StackFrameBreakpointInfo InternalBreakpointId
ibi DbgStackFrameBCOArgs ForeignRef
s -> do
          info_brks <- IO InternalModBreaks -> Debugger InternalModBreaks
forall a. IO a -> Debugger a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InternalModBreaks -> Debugger InternalModBreaks)
-> IO InternalModBreaks -> Debugger InternalModBreaks
forall a b. (a -> b) -> a -> b
$ HomeUnitGraph -> InternalBreakpointId -> IO InternalModBreaks
readIModBreaks HomeUnitGraph
hug InternalBreakpointId
ibi
          let modl  = InternalBreakpointId -> InternalModBreaks -> Module
getBreakSourceMod InternalBreakpointId
ibi InternalModBreaks
info_brks
          srcSpan   <- liftIO $ getBreakLoc (readIModModBreaks hug) ibi info_brks
          decl <- liftIO $ L.intercalate "." <$> getBreakDecls (readIModModBreaks hug) ibi info_brks

          modl_str  <- display modl
          return $ Just DbgStackFrame
            { name = modl_str ++ "." ++ decl
            , sourceSpan = realSrcSpanToSourceSpan cwd $ realSrcSpan srcSpan
            , breakId = Just ibi
            , args = Just s
            }
        StackFrameIPEInfo InfoProv
ipe -> do
          case AbsFilePath -> String -> Either String SourceSpan
srcSpanStringToSourceSpan AbsFilePath
cwd (InfoProv -> String
ipLoc InfoProv
ipe) of
            Left String
err -> do
              -- Couldn't parse. The srcLoc may be invalid so just keep this as info, not warning.
              Severity -> SDoc -> Debugger ()
logSDoc Severity
Logger.Info (SDoc -> Debugger ()) -> SDoc -> Debugger ()
forall a b. (a -> b) -> a -> b
$
                String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Couldn't parse StackEntry srcLoc \"" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
Ppr.<> String -> SDoc
forall doc. IsLine doc => String -> doc
text (InfoProv -> String
ipLoc InfoProv
ipe)
                                                           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
Ppr.<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"\":" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
err
              Maybe DbgStackFrame -> Debugger (Maybe DbgStackFrame)
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DbgStackFrame
forall a. Maybe a
Nothing
            Right SourceSpan
sourceSpan -> do
              Maybe DbgStackFrame -> Debugger (Maybe DbgStackFrame)
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DbgStackFrame -> Debugger (Maybe DbgStackFrame))
-> Maybe DbgStackFrame -> Debugger (Maybe DbgStackFrame)
forall a b. (a -> b) -> a -> b
$ DbgStackFrame -> Maybe DbgStackFrame
forall a. a -> Maybe a
Just DbgStackFrame
                { name :: String
name = InfoProv -> String
ipMod InfoProv
ipe String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ InfoProv -> String
ipLabel InfoProv
ipe
                , sourceSpan :: SourceSpan
sourceSpan = SourceSpan
sourceSpan
                , breakId :: Maybe InternalBreakpointId
breakId = Maybe InternalBreakpointId
forall a. Maybe a
Nothing
                , args :: Maybe (DbgStackFrameBCOArgs ForeignRef)
args = Maybe (DbgStackFrameBCOArgs ForeignRef)
forall a. Maybe a
Nothing
                }
        StackFrameAnnotation Maybe SrcLoc
srcLoc String
ann -> do
            Maybe DbgStackFrame -> Debugger (Maybe DbgStackFrame)
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DbgStackFrame -> Debugger (Maybe DbgStackFrame))
-> Maybe DbgStackFrame -> Debugger (Maybe DbgStackFrame)
forall a b. (a -> b) -> a -> b
$ DbgStackFrame -> Maybe DbgStackFrame
forall a. a -> Maybe a
Just DbgStackFrame
              { name :: String
name = String
ann
              , sourceSpan :: SourceSpan
sourceSpan = SourceSpan -> (SrcLoc -> SourceSpan) -> Maybe SrcLoc -> SourceSpan
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SourceSpan
unhelpfulSourceSpan (AbsFilePath -> SrcLoc -> SourceSpan
srcLocToSourceSpan AbsFilePath
cwd) Maybe SrcLoc
srcLoc
              , breakId :: Maybe InternalBreakpointId
breakId = Maybe InternalBreakpointId
forall a. Maybe a
Nothing
              , args :: Maybe (DbgStackFrameBCOArgs ForeignRef)
args = Maybe (DbgStackFrameBCOArgs ForeignRef)
forall a. Maybe a
Nothing
              }

  -- Add the latest resume context at the head.
  head_frame <- GHC.getResumeContext >>= \case
    [] ->
      -- See Note [Don't crash if not stopped]
      Maybe DbgStackFrame -> Debugger (Maybe DbgStackFrame)
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DbgStackFrame
forall a. Maybe a
Nothing
    Resume
r:[Resume]
_ -> do
      let resumeSpanR :: SrcSpan
resumeSpanR = Resume -> SrcSpan
GHC.resumeSpan Resume
r
          mRealSpan :: Maybe SourceSpan
mRealSpan   = AbsFilePath -> RealSrcSpan -> SourceSpan
realSrcSpanToSourceSpan AbsFilePath
cwd (RealSrcSpan -> SourceSpan)
-> Maybe RealSrcSpan -> Maybe SourceSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcSpan -> Maybe RealSrcSpan
srcSpanToRealSrcSpan SrcSpan
resumeSpanR
          firstSpan :: Maybe SourceSpan
firstSpan   = DbgStackFrame -> SourceSpan
DbgStackFrame.sourceSpan (DbgStackFrame -> SourceSpan)
-> Maybe DbgStackFrame -> Maybe SourceSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DbgStackFrame] -> Maybe DbgStackFrame
forall a. [a] -> Maybe a
listToMaybe [DbgStackFrame]
decoded_frames
      r_tid <- ForeignRef (ResumeContext [HValueRef]) -> Debugger RemoteThreadId
getRemoteThreadIdFromRemoteContext (Resume -> ForeignRef (ResumeContext [HValueRef])
GHC.resumeContext Resume
r)
      if r_tid /= req_tid then
        return Nothing
      else case GHC.resumeBreakpointId r of
        Just InternalBreakpointId
ibi
          | Just SourceSpan
ss <- Maybe SourceSpan
mRealSpan
          , SourceSpan -> Maybe SourceSpan
forall a. a -> Maybe a
Just SourceSpan
ss Maybe SourceSpan -> Maybe SourceSpan -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe SourceSpan
firstSpan -> do
              -- We're getting the stacktrace for the thread we're stopped at.
              info_brks <- IO InternalModBreaks -> Debugger InternalModBreaks
forall a. IO a -> Debugger a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InternalModBreaks -> Debugger InternalModBreaks)
-> IO InternalModBreaks -> Debugger InternalModBreaks
forall a b. (a -> b) -> a -> b
$ HomeUnitGraph -> InternalBreakpointId -> IO InternalModBreaks
readIModBreaks HomeUnitGraph
hug InternalBreakpointId
ibi
              let modl  = InternalBreakpointId -> InternalModBreaks -> Module
getBreakSourceMod InternalBreakpointId
ibi InternalModBreaks
info_brks
              modl_str  <- display modl
              return $
                Just DbgStackFrame
                  { name = modl_str ++ "." ++ GHC.resumeDecl r
                  , sourceSpan = ss
                  , breakId = Just ibi
                  , args = Nothing
                  }
        Maybe InternalBreakpointId
_ -> do
          mExcSpan <- ExceptionInfo -> Maybe SourceSpan
exceptionInfoSourceSpan (ExceptionInfo -> Maybe SourceSpan)
-> Debugger ExceptionInfo -> Debugger (Maybe SourceSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RemoteThreadId -> Debugger ExceptionInfo
getExceptionInfo RemoteThreadId
req_tid
          case mExcSpan of
            Just SourceSpan
sourceSpan ->  Maybe DbgStackFrame -> Debugger (Maybe DbgStackFrame)
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DbgStackFrame -> Debugger (Maybe DbgStackFrame))
-> Maybe DbgStackFrame -> Debugger (Maybe DbgStackFrame)
forall a b. (a -> b) -> a -> b
$ DbgStackFrame -> Maybe DbgStackFrame
forall a. a -> Maybe a
Just DbgStackFrame
                                  { name :: String
name = Resume -> String
GHC.resumeDecl Resume
r
                                  , SourceSpan
sourceSpan :: SourceSpan
sourceSpan :: SourceSpan
sourceSpan
                                  , breakId :: Maybe InternalBreakpointId
breakId = Maybe InternalBreakpointId
forall a. Maybe a
Nothing
                                  , args :: Maybe (DbgStackFrameBCOArgs ForeignRef)
args = Maybe (DbgStackFrameBCOArgs ForeignRef)
forall a. Maybe a
Nothing
                                  }
            Maybe SourceSpan
Nothing -> Maybe DbgStackFrame -> Debugger (Maybe DbgStackFrame)
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DbgStackFrame
forall a. Maybe a
Nothing
  return (maybe id (:) head_frame $ decoded_frames)

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

-- | Get the stack frames at the point we're stopped at
getScopes :: RemoteThreadId -> Int -> Debugger [ScopeInfo]
getScopes :: RemoteThreadId -> Int -> Debugger [ScopeInfo]
getScopes RemoteThreadId
threadId Int
frameIx = do
  frames <- RemoteThreadId -> Debugger [DbgStackFrame]
getStacktrace RemoteThreadId
threadId
  let frame = [DbgStackFrame]
frames [DbgStackFrame] -> Int -> DbgStackFrame
forall a. HasCallStack => [a] -> Int -> a
!! Int
frameIx
  let sourceSpan = DbgStackFrame -> SourceSpan
DbgStackFrame.sourceSpan DbgStackFrame
frame
      localsScope = ScopeInfo
        { kind :: ScopeVariablesReference
kind = ScopeVariablesReference
LocalVariablesScope
        , expensive :: Bool
expensive = Bool
False
        , numVars :: Maybe Int
numVars = Maybe Int
forall a. Maybe a
Nothing
        , SourceSpan
sourceSpan :: SourceSpan
sourceSpan :: SourceSpan
sourceSpan
        }
  if
    | frameIx < length frames
    , Just ibi <- DbgStackFrame.breakId frame
    -> do
      hsc_env   <- getSession
      info_brks <- liftIO $ readIModBreaks (hsc_HUG hsc_env) ibi
      let brk_modl = InternalBreakpointId -> InternalModBreaks -> Module
getBreakSourceMod InternalBreakpointId
ibi InternalModBreaks
info_brks
      -- 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.
      in_mod   <- getTopEnv brk_modl
      imported <- getTopImported brk_modl
      return
        [ localsScope
        , ScopeInfo { kind = ModuleVariablesScope
                    , expensive = True
                    , numVars = Just (sizeUFM in_mod)
                    , sourceSpan
                    }
        , ScopeInfo { kind = GlobalVariablesScope
                    , expensive = True
                    , numVars = Just (sizeOccEnv imported)
                    , sourceSpan
                    }
        ]
    | otherwise ->
      return [localsScope]

--------------------------------------------------------------------------------
-- * 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.
--
-- When the request forces a variable, return 'ForcedVariable'. Otherwise return
-- the resulting variables/fields.
--
-- See Note [Variables Requests]
getVariables :: RemoteThreadId -> Int{-stack frame index-} -> VariableReference -> Debugger VariableResult
getVariables :: RemoteThreadId
-> Int -> VariableReference -> Debugger VariableResult
getVariables RemoteThreadId
threadId Int
frameIx VariableReference
vk = do
  frames <- RemoteThreadId -> Debugger [DbgStackFrame]
getStacktrace RemoteThreadId
threadId
  let frame = [DbgStackFrame]
frames [DbgStackFrame] -> Int -> DbgStackFrame
forall a. HasCallStack => [a] -> Int -> a
!! Int
frameIx
  hsc_env <- getSession
  fam_envs <- getFamInstEnvs'
  case vk of
    -- Only `seq` the variable when inspecting a specific one (`SpecificVariable`)
    -- (VARR)(b,c)
    SpecificVariable 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' <- Term -> Debugger Term
forceTerm Term
term

          vi <- termToVarInfo fam_envs key term'

          return (ForcedVariable vi)

        -- (VARR)(c)
        Term
_ -> do

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

          FamInstEnvs -> TermKey -> Term -> Debugger VarFields
termVarFields FamInstEnvs
fam_envs TermKey
key Term
term Debugger VarFields
-> (VarFields -> Debugger VariableResult)
-> Debugger VariableResult
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 [VarInfo]
vfs -> VariableResult -> Debugger VariableResult
forall a. a -> Debugger a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([VarInfo] -> VariableResult
VariableFields [VarInfo]
vfs)

    -- (VARR)(a) from here onwards
    VariableReference
LocalVariables -> ([VarInfo] -> VariableResult)
-> Debugger [VarInfo] -> Debugger VariableResult
forall a b. (a -> b) -> Debugger a -> Debugger b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [VarInfo] -> VariableResult
VariableFields (Debugger [VarInfo] -> Debugger VariableResult)
-> Debugger [VarInfo] -> Debugger VariableResult
forall a b. (a -> b) -> a -> b
$ do
      vars <- if Int
frameIx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then
          -- top frame vars already bound when stopping
          Debugger [TyThing]
forall (m :: * -> *). GhcMonad m => m [TyThing]
GHC.getBindings
        else
          (Id -> TyThing) -> [Id] -> [TyThing]
forall a b. (a -> b) -> [a] -> [b]
map Id -> TyThing
AnId ([Id] -> [TyThing]) -> Debugger [Id] -> Debugger [TyThing]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DbgStackFrame -> Debugger [Id]
getStackFrameBindings DbgStackFrame
frame
      mapM (tyThingToVarInfo fam_envs) vars

    VariableReference
ModuleVariables
      | Int
frameIx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [DbgStackFrame] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DbgStackFrame]
frames
      , Just InternalBreakpointId
ibi <- DbgStackFrame -> Maybe InternalBreakpointId
DbgStackFrame.breakId DbgStackFrame
frame
      -> ([VarInfo] -> VariableResult)
-> Debugger [VarInfo] -> Debugger VariableResult
forall a b. (a -> b) -> Debugger a -> Debugger b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [VarInfo] -> VariableResult
VariableFields (Debugger [VarInfo] -> Debugger VariableResult)
-> Debugger [VarInfo] -> Debugger VariableResult
forall a b. (a -> b) -> a -> b
$ do
        curr_modl <- IO Module -> Debugger Module
forall a. IO a -> Debugger a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Module -> Debugger Module) -> IO Module -> Debugger Module
forall a b. (a -> b) -> a -> b
$ InternalBreakpointId -> InternalModBreaks -> Module
getBreakSourceMod InternalBreakpointId
ibi (InternalModBreaks -> Module) -> IO InternalModBreaks -> IO Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                      HomeUnitGraph -> InternalBreakpointId -> IO InternalModBreaks
readIModBreaks (HscEnv -> HomeUnitGraph
hsc_HUG HscEnv
hsc_env) InternalBreakpointId
ibi
        things <- typeEnvElts <$> getTopEnv curr_modl
        mapM (\TyThing
tt -> do
          nameStr <- Name -> Debugger String
forall (m :: * -> *) a. (GhcMonad m, Outputable a) => a -> m String
display (TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
tt)
          vi <- tyThingToVarInfo fam_envs tt
          return vi{varName = nameStr}) things

    VariableReference
GlobalVariables
      | Int
frameIx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [DbgStackFrame] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DbgStackFrame]
frames
      , Just InternalBreakpointId
ibi <- DbgStackFrame -> Maybe InternalBreakpointId
DbgStackFrame.breakId DbgStackFrame
frame
      -> ([VarInfo] -> VariableResult)
-> Debugger [VarInfo] -> Debugger VariableResult
forall a b. (a -> b) -> Debugger a -> Debugger b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [VarInfo] -> VariableResult
VariableFields (Debugger [VarInfo] -> Debugger VariableResult)
-> Debugger [VarInfo] -> Debugger VariableResult
forall a b. (a -> b) -> a -> b
$ do
        curr_modl <- IO Module -> Debugger Module
forall a. IO a -> Debugger a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Module -> Debugger Module) -> IO Module -> Debugger Module
forall a b. (a -> b) -> a -> b
$ InternalBreakpointId -> InternalModBreaks -> Module
getBreakSourceMod InternalBreakpointId
ibi (InternalModBreaks -> Module) -> IO InternalModBreaks -> IO Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                      HomeUnitGraph -> InternalBreakpointId -> IO InternalModBreaks
readIModBreaks (HscEnv -> HomeUnitGraph
hsc_HUG HscEnv
hsc_env) InternalBreakpointId
ibi
        names <- map greName . globalRdrEnvElts <$> getTopImported curr_modl
        mapM (\Name
n-> do
          nameStr <- Name -> Debugger String
forall (m :: * -> *) a. (GhcMonad m, Outputable a) => a -> m 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 <- FamInstEnvs -> TyThing -> Debugger VarInfo
tyThingToVarInfo FamInstEnvs
fam_envs TyThing
tt
              return vi{varName = nameStr}
          ) names

    VariableReference
NoVariables -> VariableResult -> Debugger VariableResult
forall a. a -> Debugger a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([VarInfo] -> VariableResult
VariableFields [])

    -- Couldn't find ibi or frame
    VariableReference
_otherwise -> VariableResult -> Debugger VariableResult
forall a. a -> Debugger a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([VarInfo] -> VariableResult
VariableFields [])

--------------------------------------------------------------------------------
-- 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
    Just HomeModInfo
hmi -> HscEnv -> HomeModInfo -> IO GlobalRdrEnv
mkTopLevImportedEnv HscEnv
hsc_env HomeModInfo
hmi