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

import System.Exit
import Control.Monad.IO.Class

#if MIN_VERSION_ghc(9,13,20250417)
import GHC.Types.Name.Occurrence (sizeOccEnv)
#endif

import GHC.Debugger.Breakpoint
import GHC.Debugger.Evaluation
import GHC.Debugger.Stopped
import GHC.Debugger.Monad
import GHC.Debugger.Utils
import GHC.Debugger.Interface.Messages

--------------------------------------------------------------------------------
-- * Executing commands
--------------------------------------------------------------------------------

-- | Execute the given debugger command in the current 'Debugger' session
execute :: Command -> Debugger Response
execute :: Command -> Debugger Response
execute = \case
  Command
ClearFunctionBreakpoints -> Response
DidClearBreakpoints Response -> Debugger () -> Debugger Response
forall a b. a -> Debugger b -> Debugger a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe FilePath -> Debugger ()
clearBreakpoints Maybe FilePath
forall a. Maybe a
Nothing
  ClearModBreakpoints FilePath
fp -> Response
DidClearBreakpoints Response -> Debugger () -> Debugger Response
forall a b. a -> Debugger b -> Debugger a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe FilePath -> Debugger ()
clearBreakpoints (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
fp)
  SetBreakpoint Breakpoint
bp -> BreakFound -> Response
DidSetBreakpoint (BreakFound -> Response)
-> Debugger BreakFound -> Debugger Response
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Breakpoint -> BreakpointStatus -> Debugger BreakFound
setBreakpoint Breakpoint
bp BreakpointStatus
BreakpointEnabled
  DelBreakpoint Breakpoint
bp -> BreakFound -> Response
DidRemoveBreakpoint (BreakFound -> Response)
-> Debugger BreakFound -> Debugger Response
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Breakpoint -> BreakpointStatus -> Debugger BreakFound
setBreakpoint Breakpoint
bp BreakpointStatus
BreakpointDisabled
  GetBreakpointsAt ModuleBreak{FilePath
path :: FilePath
path :: Breakpoint -> FilePath
path, Int
lineNum :: Int
lineNum :: Breakpoint -> Int
lineNum, Maybe Int
columnNum :: Maybe Int
columnNum :: Breakpoint -> Maybe Int
columnNum} -> do
    mmodl <- FilePath -> Debugger (Either FilePath ModSummary)
getModuleByPath FilePath
path
    case mmodl of
      Left FilePath
e -> do
        [FilePath] -> Debugger ()
displayWarnings [FilePath
e]
        Response -> Debugger Response
forall a. a -> Debugger a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> Debugger Response) -> Response -> Debugger Response
forall a b. (a -> b) -> a -> b
$ Maybe SourceSpan -> Response
DidGetBreakpoints Maybe SourceSpan
forall a. Maybe a
Nothing
      Right ModSummary
modl -> do
        mbfnd <- ModSummary
-> Int -> Maybe Int -> Debugger (Maybe (Int, RealSrcSpan))
getBreakpointsAt ModSummary
modl Int
lineNum Maybe Int
columnNum
        return $
          DidGetBreakpoints (realSrcSpanToSourceSpan . snd <$> mbfnd)
  GetBreakpointsAt Breakpoint
_ -> FilePath -> Debugger Response
forall a. HasCallStack => FilePath -> a
error FilePath
"unexpected getbreakpoints without ModuleBreak"
  Command
GetStacktrace -> [StackFrame] -> Response
GotStacktrace ([StackFrame] -> Response)
-> Debugger [StackFrame] -> Debugger Response
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Debugger [StackFrame]
getStacktrace
  Command
GetScopes -> [ScopeInfo] -> Response
GotScopes ([ScopeInfo] -> Response)
-> Debugger [ScopeInfo] -> Debugger Response
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Debugger [ScopeInfo]
getScopes
  GetVariables VariableReference
kind -> Either VarInfo [VarInfo] -> Response
GotVariables (Either VarInfo [VarInfo] -> Response)
-> Debugger (Either VarInfo [VarInfo]) -> Debugger Response
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableReference -> Debugger (Either VarInfo [VarInfo])
getVariables VariableReference
kind
  DoEval FilePath
exp_s -> EvalResult -> Response
DidEval (EvalResult -> Response)
-> Debugger EvalResult -> Debugger Response
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Debugger EvalResult
doEval FilePath
exp_s
  Command
DoContinue -> EvalResult -> Response
DidContinue (EvalResult -> Response)
-> Debugger EvalResult -> Debugger Response
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Debugger EvalResult
doContinue
  Command
DoSingleStep -> EvalResult -> Response
DidStep (EvalResult -> Response)
-> Debugger EvalResult -> Debugger Response
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Debugger EvalResult
doSingleStep
  Command
DoStepLocal -> EvalResult -> Response
DidStep (EvalResult -> Response)
-> Debugger EvalResult -> Debugger Response
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Debugger EvalResult
doLocalStep
  DebugExecution { EntryPoint
entryPoint :: EntryPoint
entryPoint :: Command -> EntryPoint
entryPoint, [FilePath]
runArgs :: [FilePath]
runArgs :: Command -> [FilePath]
runArgs } -> EvalResult -> Response
DidExec (EvalResult -> Response)
-> Debugger EvalResult -> Debugger Response
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EntryPoint -> [FilePath] -> Debugger EvalResult
debugExecution EntryPoint
entryPoint [FilePath]
runArgs
  Command
TerminateProcess -> IO Response -> Debugger Response
forall a. IO a -> Debugger a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Response -> Debugger Response)
-> IO Response -> Debugger Response
forall a b. (a -> b) -> a -> b
$ do
    -- Terminate!
    ExitCode -> IO Response
forall a. ExitCode -> IO a
exitWith ExitCode
ExitSuccess