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

import Control.Monad.IO.Class
import Control.Monad.Catch
import qualified Data.List as List
import Data.Maybe
import System.FilePath
import qualified Prettyprinter as Pretty

import GHC
import GHC.Builtin.Names (gHC_INTERNAL_GHCI_HELPERS)
import GHC.Unit.Types
import GHC.Data.FastString
import GHC.Driver.DynFlags as GHC
import GHC.Driver.Monad as GHC
import GHC.Driver.Env as GHC
import GHC.Runtime.Debugger.Breakpoints as GHC
import qualified GHC.Unit.Module.ModSummary as GHC
import GHC.ByteCode.Breakpoints
import GHC.Types.Name.Occurrence (mkVarOccFS)
import GHC.Types.Name.Reader as RdrName (mkOrig)
import GHC.Utils.Outputable as GHC
import qualified GHCi.Message as GHCi
import qualified GHC.Data.Strict as Strict

import GHC.Debugger.Stopped.Variables
import GHC.Debugger.Monad
import GHC.Debugger.Utils
import GHC.Debugger.Interface.Messages
import GHC.Debugger.Logger

data EvalLog
  = LogEvalModule GHC.Module

instance Pretty EvalLog where
  pretty :: forall ann. EvalLog -> Doc ann
pretty = \ case
    LogEvalModule Module
modl -> Doc ann
"Eval Module Context:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.<+> [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (SDoc -> [Char]
GHC.showSDocUnsafe (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
modl))

--------------------------------------------------------------------------------
-- * Evaluation
--------------------------------------------------------------------------------

-- | Run a program with debugging enabled
debugExecution :: Recorder (WithSeverity EvalLog) -> FilePath -> EntryPoint -> [String] {-^ Args -} -> Debugger EvalResult
debugExecution :: Recorder (WithSeverity EvalLog)
-> [Char] -> EntryPoint -> [[Char]] -> Debugger EvalResult
debugExecution Recorder (WithSeverity EvalLog)
recorder [Char]
entryFile EntryPoint
entry [[Char]]
args = do

  -- consider always using :trace like ghci-dap to always have a stacktrace?
  -- better solution could involve profiling stack traces or from IPE info?
  modSummaryOfEntryFile <- [Char] -> Debugger ModSummary
forall (m :: * -> *). GhcMonad m => [Char] -> m ModSummary
findUnitIdOfEntryFile [Char]
entryFile
  let modOfEntryFile = ModSummary -> Module
GHC.ms_mod ModSummary
modSummaryOfEntryFile
      unitIdOfEntryFile = ModSummary -> UnitId
GHC.ms_unitid ModSummary
modSummaryOfEntryFile

  let
    evalModule = GenUnit UnitId -> ModuleName -> Module
forall u. u -> ModuleName -> GenModule u
mkModule (Definite UnitId -> GenUnit UnitId
forall uid. Definite uid -> GenUnit uid
RealUnit (UnitId -> Definite UnitId
forall unit. unit -> Definite unit
Definite UnitId
unitIdOfEntryFile))
                                         (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
modOfEntryFile)

  logWith recorder Info $ LogEvalModule evalModule
  old_context <- GHC.getContext
  GHC.setContext [GHC.IIModule evalModule]

  (entryExp, exOpts) <- case entry of
    MainEntry Maybe [Char]
nm -> do
      let prog :: [Char]
prog = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"main" Maybe [Char]
nm
      -- the wrapper is equivalent to GHCi's `:main arg1 arg2 arg3`
      wrapper <- [Char] -> [[Char]] -> Debugger ForeignHValue
forall (m :: * -> *).
GhcMonad m =>
[Char] -> [[Char]] -> m ForeignHValue
mkEvalWrapper [Char]
prog [[Char]]
args -- bit weird that the prog name is the expression but fine
      let execWrap' ForeignHValue
fhv = EvalExpr ForeignHValue
-> EvalExpr ForeignHValue -> EvalExpr ForeignHValue
forall a. EvalExpr a -> EvalExpr a -> EvalExpr a
GHCi.EvalApp (ForeignHValue -> EvalExpr ForeignHValue
forall a. a -> EvalExpr a
GHCi.EvalThis ForeignHValue
wrapper) (ForeignHValue -> EvalExpr ForeignHValue
forall a. a -> EvalExpr a
GHCi.EvalThis ForeignHValue
fhv)
          opts = ExecOptions
GHC.execOptions {execWrap = execWrap'}
      return (prog, opts)

    FunctionEntry [Char]
fn ->
      -- TODO: if "args" is unescaped (e.g. "some", "thing"), then "some" and
      -- "thing" will be interpreted as variables. To pass strings it needs to
      -- be "\"some\"" "\"things\"".
      ([Char], ExecOptions) -> Debugger ([Char], ExecOptions)
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
fn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords [[Char]]
args, ExecOptions
GHC.execOptions)

  exec_res <- GHC.execStmt entryExp exOpts
  GHC.setContext old_context -- restore context after running `main`
  handleExecResult exec_res
  where
    -- It's not ideal to duplicate these two functions from ghci, but its unclear where they would better live. Perhaps next to compileParsedExprRemote? The issue is run
    mkEvalWrapper :: GhcMonad m => String -> [String] -> m ForeignHValue
    mkEvalWrapper :: forall (m :: * -> *).
GhcMonad m =>
[Char] -> [[Char]] -> m ForeignHValue
mkEvalWrapper [Char]
progname' [[Char]]
args' =
      m ForeignHValue -> m ForeignHValue
forall (m :: * -> *) a. GhcMonad m => m a -> m a
runInternal (m ForeignHValue -> m ForeignHValue)
-> m ForeignHValue -> m ForeignHValue
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> m ForeignHValue
forall (m :: * -> *).
GhcMonad m =>
LHsExpr GhcPs -> m ForeignHValue
GHC.compileParsedExprRemote
      (LHsExpr GhcPs -> m ForeignHValue)
-> LHsExpr GhcPs -> m ForeignHValue
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
evalWrapper' LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
`GHC.mkHsApp` [Char] -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall {p :: Pass}.
[Char] -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
nlHsString [Char]
progname'
                     LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
`GHC.mkHsApp` [LHsExpr GhcPs] -> LHsExpr GhcPs
nlList (([Char] -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [[Char]] -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall {p :: Pass}.
[Char] -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
nlHsString [[Char]]
args')
      where
        nlHsString :: [Char] -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
nlHsString = HsLit (GhcPass p) -> LHsExpr (GhcPass p)
HsLit (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit (HsLit (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> ([Char] -> HsLit (GhcPass p))
-> [Char]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> HsLit (GhcPass p)
forall (p :: Pass). [Char] -> HsLit (GhcPass p)
mkHsString
        evalWrapper' :: LHsExpr GhcPs
evalWrapper' =
          IdP GhcPs -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
GHC.nlHsVar (IdP GhcPs -> LHsExpr GhcPs) -> IdP GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ Module -> OccName -> RdrName
RdrName.mkOrig Module
gHC_INTERNAL_GHCI_HELPERS (FastString -> OccName
mkVarOccFS ([Char] -> FastString
fsLit [Char]
"evalWrapper"))

    -- run internal here serves to overwrite certain flags while executing the
    -- internal "evalWrapper" computation which is not relevant to the user.
    runInternal :: GhcMonad m => m a -> m a
    runInternal :: forall (m :: * -> *) a. GhcMonad m => m a -> m a
runInternal =
        (HscEnv -> HscEnv) -> m a -> m a
forall (m :: * -> *) a.
GhcMonad m =>
(HscEnv -> HscEnv) -> m a -> m a
withTempSession HscEnv -> HscEnv
mkTempSession
      where
        mkTempSession :: HscEnv -> HscEnv
mkTempSession = (DynFlags -> DynFlags) -> HscEnv -> HscEnv
hscUpdateFlags (\DynFlags
dflags -> DynFlags
dflags
          { -- Disable dumping of any data during evaluation of GHCi's internal expressions. (#17500)
            dumpFlags = mempty
          }
              -- We depend on -fimplicit-import-qualified to compile expr
              -- with fully qualified names without imports (gHC_INTERNAL_GHCI_HELPERS above).
              DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_ImplicitImportQualified
          )

    findUnitIdOfEntryFile :: GhcMonad m => FilePath -> m GHC.ModSummary
    findUnitIdOfEntryFile :: forall (m :: * -> *). GhcMonad m => [Char] -> m ModSummary
findUnitIdOfEntryFile [Char]
fp = do
      modSums <- m [ModSummary]
forall (m :: * -> *). GhcMonad m => m [ModSummary]
getAllLoadedModules
      case List.find ((Just fp ==) . fmap normalise . GHC.ml_hs_file . GHC.ms_location ) modSums of
        Maybe ModSummary
Nothing -> [Char] -> m ModSummary
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ModSummary) -> [Char] -> m ModSummary
forall a b. (a -> b) -> a -> b
$ [Char]
"findUnitIdOfEntryFile: no unit id found for: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
fp
        Just ModSummary
summary -> ModSummary -> m ModSummary
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModSummary
summary

-- | Resume execution of the stopped debuggee program
doContinue :: Debugger EvalResult
doContinue :: Debugger EvalResult
doContinue = do
  Debugger ()
leaveSuspendedState
  SingleStep -> Maybe Int -> Debugger ExecResult
forall (m :: * -> *).
GhcMonad m =>
SingleStep -> Maybe Int -> m ExecResult
GHC.resumeExec SingleStep
RunToCompletion Maybe Int
forall a. Maybe a
Nothing
    Debugger ExecResult
-> (ExecResult -> Debugger EvalResult) -> Debugger EvalResult
forall a b. Debugger a -> (a -> Debugger b) -> Debugger b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExecResult -> Debugger EvalResult
handleExecResult

-- | Resume execution but only take a single step.
doSingleStep :: Debugger EvalResult
doSingleStep :: Debugger EvalResult
doSingleStep = do
  Debugger ()
leaveSuspendedState
  SingleStep -> Maybe Int -> Debugger ExecResult
forall (m :: * -> *).
GhcMonad m =>
SingleStep -> Maybe Int -> m ExecResult
GHC.resumeExec SingleStep
SingleStep Maybe Int
forall a. Maybe a
Nothing
    Debugger ExecResult
-> (ExecResult -> Debugger EvalResult) -> Debugger EvalResult
forall a b. Debugger a -> (a -> Debugger b) -> Debugger b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExecResult -> Debugger EvalResult
handleExecResult

doStepOut :: Debugger EvalResult
doStepOut :: Debugger EvalResult
doStepOut = do
  Debugger ()
leaveSuspendedState
  mb_span <- Debugger (Maybe SrcSpan)
forall (m :: * -> *). GhcMonad m => m (Maybe SrcSpan)
getCurrentBreakSpan
  case mb_span of
    Maybe SrcSpan
Nothing ->
      SingleStep -> Maybe Int -> Debugger ExecResult
forall (m :: * -> *).
GhcMonad m =>
SingleStep -> Maybe Int -> m ExecResult
GHC.resumeExec (Maybe SrcSpan -> SingleStep
GHC.StepOut Maybe SrcSpan
forall a. Maybe a
Nothing) Maybe Int
forall a. Maybe a
Nothing
        Debugger ExecResult
-> (ExecResult -> Debugger EvalResult) -> Debugger EvalResult
forall a b. Debugger a -> (a -> Debugger b) -> Debugger b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExecResult -> Debugger EvalResult
handleExecResult
    Just SrcSpan
loc -> do
      md <- Module -> Maybe Module -> Module
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Module
forall a. HasCallStack => [Char] -> a
error [Char]
"doStepOut") (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
      ticks <- fromMaybe (error "doLocalStep:getTicks") <$> makeModuleLineMap md
      let current_toplevel_decl = TickArray -> SrcSpan -> RealSrcSpan
enclosingTickSpan TickArray
ticks SrcSpan
loc
      GHC.resumeExec (GHC.StepOut (Just (RealSrcSpan current_toplevel_decl Strict.Nothing))) Nothing
        >>= handleExecResult

-- | Resume execution but stop at the next tick within the same function.
--
-- To do a local step, we get the SrcSpan of the current suspension state and
-- get its 'enclosingTickSpan' to use as a filter for breakpoints in the call
-- to 'resumeExec'. Execution will only stop at breakpoints whose span matches
-- this enclosing span.
doLocalStep :: Debugger EvalResult
doLocalStep :: Debugger EvalResult
doLocalStep = do
  Debugger ()
leaveSuspendedState
  mb_span <- Debugger (Maybe SrcSpan)
forall (m :: * -> *). GhcMonad m => m (Maybe SrcSpan)
getCurrentBreakSpan
  case mb_span of
    Maybe SrcSpan
Nothing -> [Char] -> Debugger EvalResult
forall a. HasCallStack => [Char] -> a
error [Char]
"not stopped at a breakpoint?!"
    Just (UnhelpfulSpan UnhelpfulSpanReason
_) -> do
      IO () -> Debugger ()
forall a. IO a -> Debugger a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Debugger ()) -> IO () -> Debugger ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"Stopped at an exception. Forcing step into..."
      SingleStep -> Maybe Int -> Debugger ExecResult
forall (m :: * -> *).
GhcMonad m =>
SingleStep -> Maybe Int -> m ExecResult
GHC.resumeExec SingleStep
SingleStep Maybe Int
forall a. Maybe a
Nothing Debugger ExecResult
-> (ExecResult -> Debugger EvalResult) -> Debugger EvalResult
forall a b. Debugger a -> (a -> Debugger b) -> Debugger b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExecResult -> Debugger EvalResult
handleExecResult
    Just SrcSpan
loc -> do
      md <- Module -> Maybe Module -> Module
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Module
forall a. HasCallStack => [Char] -> a
error [Char]
"doLocalStep") (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
      -- TODO: Cache moduleLineMap.
      ticks <- fromMaybe (error "doLocalStep:getTicks") <$> makeModuleLineMap md
      let current_toplevel_decl = TickArray -> SrcSpan -> RealSrcSpan
enclosingTickSpan TickArray
ticks SrcSpan
loc
      GHC.resumeExec (LocalStep (RealSrcSpan current_toplevel_decl mempty)) Nothing >>= handleExecResult

-- | Evaluate expression. Includes context of breakpoint if stopped at one (the current interactive context).
doEval :: String -> Debugger EvalResult
doEval :: [Char] -> Debugger EvalResult
doEval [Char]
expr = do
  excr <- (ExecResult -> Either [Char] ExecResult
forall a b. b -> Either a b
Right (ExecResult -> Either [Char] ExecResult)
-> Debugger ExecResult -> Debugger (Either [Char] ExecResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> ExecOptions -> Debugger ExecResult
forall (m :: * -> *).
GhcMonad m =>
[Char] -> ExecOptions -> m ExecResult
GHC.execStmt [Char]
expr ExecOptions
GHC.execOptions) Debugger (Either [Char] ExecResult)
-> (SomeException -> Debugger (Either [Char] ExecResult))
-> Debugger (Either [Char] ExecResult)
forall e a.
(HasCallStack, Exception e) =>
Debugger a -> (e -> Debugger a) -> Debugger a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(SomeException
e::SomeException) -> Either [Char] ExecResult -> Debugger (Either [Char] ExecResult)
forall a. a -> Debugger a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Either [Char] ExecResult
forall a b. a -> Either a b
Left (SomeException -> [Char]
forall e. Exception e => e -> [Char]
displayException SomeException
e))
  case excr of
    Left [Char]
err -> EvalResult -> Debugger EvalResult
forall a. a -> Debugger a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvalResult -> Debugger EvalResult)
-> EvalResult -> Debugger EvalResult
forall a b. (a -> b) -> a -> b
$ [Char] -> EvalResult
EvalAbortedWith [Char]
err
    Right ExecBreak{} -> Debugger ExecResult
continueToCompletion Debugger ExecResult
-> (ExecResult -> Debugger EvalResult) -> Debugger EvalResult
forall a b. Debugger a -> (a -> Debugger b) -> Debugger b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExecResult -> Debugger EvalResult
handleExecResult
    Right r :: ExecResult
r@ExecComplete{} -> ExecResult -> Debugger EvalResult
handleExecResult ExecResult
r

-- | Turn a GHC's 'ExecResult' into an 'EvalResult' response
handleExecResult :: GHC.ExecResult -> Debugger EvalResult
handleExecResult :: ExecResult -> Debugger EvalResult
handleExecResult = \case
    ExecComplete {Either SomeException [Name]
execResult :: Either SomeException [Name]
execResult :: ExecResult -> Either SomeException [Name]
execResult} -> do
      case Either SomeException [Name]
execResult of
        Left SomeException
e -> EvalResult -> Debugger EvalResult
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> [Char] -> EvalResult
EvalException (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e) [Char]
"SomeException")
        Right [] -> EvalResult -> Debugger EvalResult
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> [Char] -> EvalResult
EvalCompleted [Char]
"" [Char]
"") -- Evaluation completed without binding any result.
        Right (Name
n:[Name]
_ns) -> Name -> Debugger (Maybe VarInfo)
inspectName Name
n Debugger (Maybe VarInfo)
-> (Maybe VarInfo -> Debugger EvalResult) -> Debugger EvalResult
forall a b. Debugger a -> (a -> Debugger b) -> Debugger b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just VarInfo{[Char]
varValue :: [Char]
varValue :: VarInfo -> [Char]
varValue, [Char]
varType :: [Char]
varType :: VarInfo -> [Char]
varType} -> EvalResult -> Debugger EvalResult
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> [Char] -> EvalResult
EvalCompleted [Char]
varValue [Char]
varType)
          Maybe VarInfo
Nothing     -> IO EvalResult -> Debugger EvalResult
forall a. IO a -> Debugger a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EvalResult -> Debugger EvalResult)
-> IO EvalResult -> Debugger EvalResult
forall a b. (a -> b) -> a -> b
$ [Char] -> IO EvalResult
forall a. HasCallStack => [Char] -> IO a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
[Char] -> m a
fail [Char]
"doEval failed"
    ExecBreak {breakNames :: ExecResult -> [Name]
breakNames = [Name]
_, breakPointId :: ExecResult -> Maybe InternalBreakpointId
breakPointId = Maybe InternalBreakpointId
Nothing} ->
      -- Stopped at an exception
      -- TODO: force the exception to display string with Backtrace?
      EvalResult -> Debugger EvalResult
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return EvalStopped{breakId :: Maybe BreakpointId
breakId = Maybe BreakpointId
forall a. Maybe a
Nothing}
    ExecBreak {breakNames :: ExecResult -> [Name]
breakNames = [Name]
_, Maybe InternalBreakpointId
breakPointId :: ExecResult -> Maybe InternalBreakpointId
breakPointId :: Maybe InternalBreakpointId
breakPointId} ->
#if MIN_VERSION_ghc(9,14,2)
      return EvalStopped{breakId = breakPointId}
#else
      EvalResult -> Debugger EvalResult
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return EvalStopped{breakId :: Maybe BreakpointId
breakId = InternalBreakpointId -> BreakpointId
toBreakpointId (InternalBreakpointId -> BreakpointId)
-> Maybe InternalBreakpointId -> Maybe BreakpointId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InternalBreakpointId
breakPointId}
#endif

-- | Get the value and type of a given 'Name' as rendered strings in 'VarInfo'.
inspectName :: Name -> Debugger (Maybe VarInfo)
inspectName :: Name -> Debugger (Maybe VarInfo)
inspectName Name
n = do
  Name -> Debugger (Maybe TyThing)
forall (m :: * -> *). GhcMonad m => Name -> m (Maybe TyThing)
GHC.lookupName Name
n Debugger (Maybe TyThing)
-> (Maybe TyThing -> Debugger (Maybe VarInfo))
-> Debugger (Maybe 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 TyThing
Nothing -> do
      IO () -> Debugger ()
forall a. IO a -> Debugger a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Debugger ())
-> ([Char] -> IO ()) -> [Char] -> Debugger ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
putStrLn ([Char] -> Debugger ()) -> Debugger [Char] -> Debugger ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SDoc -> Debugger [Char]
forall a. Outputable a => a -> Debugger [Char]
display ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Failed to lookup name: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
      Maybe VarInfo -> Debugger (Maybe VarInfo)
forall a. a -> Debugger a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe VarInfo
forall a. Maybe a
Nothing
    Just TyThing
tt -> VarInfo -> Maybe VarInfo
forall a. a -> Maybe a
Just (VarInfo -> Maybe VarInfo)
-> Debugger VarInfo -> Debugger (Maybe VarInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyThing -> Debugger VarInfo
tyThingToVarInfo TyThing
tt