{-# LANGUAGE DeriveGeneric,
             StandaloneDeriving,
             OverloadedStrings,
             DuplicateRecordFields,
             TypeApplications
             #-}
{-# OPTIONS_GHC -Wno-orphans #-} -- JSON GHC.BreakpointId

-- | Types for sending and receiving messages to/from ghc-debugger
module GHC.Debugger.Interface.Messages where

import GHC.Generics
import Data.Aeson
import qualified GHC
import qualified GHC.Utils.Outputable as GHC
import GHC.Unit.Types
import Language.Haskell.Syntax.Module.Name

--------------------------------------------------------------------------------
-- Commands
--------------------------------------------------------------------------------

-- | The commands sent to ghc debugger
data Command

  -- | Set a breakpoint on a given function, or module by line number
  = SetBreakpoint Breakpoint

  -- | Delete a breakpoint on a given function, or module by line number
  | DelBreakpoint Breakpoint

  -- | Find the valid breakpoints locations for the given module Breakpoint
  | GetBreakpointsAt Breakpoint

  -- | Clear all breakpoints in the specified file.
  -- This is useful because DAP's `setBreakpoints` re-sets all breakpoints from zero for a source rather than incrementally.
  | ClearModBreakpoints { Command -> FilePath
file :: FilePath }

  -- | Clear all function breakpoints
  | ClearFunctionBreakpoints

  -- | Get the evaluation stacktrace until the current breakpoint.
  | GetStacktrace

  -- | Get the list of available scopes at the current breakpoint
  | GetScopes

  -- | Get the variables in scope for the current breakpoint.
  --
  -- Note: for GHCs <9.13 this only reports the variables free in the expression
  -- we're stopped at rather than all variables in scope.
  | GetVariables VariableReference

  -- | Evaluate an expression at the current breakpoint.
  | DoEval String

  -- | Continue executing from the current breakpoint
  | DoContinue

  -- | Step local, which executes until next breakpoint in the same function.
  | DoStepLocal

  -- | Single step always to the next breakpoint. Used for "step-in".
  | DoSingleStep

  -- | Execute a prog with debugging enabled. Breaks on the existing breakpoints.
  --
  -- Constructed with an entry point function name and the arguments to pass it.
  --
  -- When the @'EntryPoint'@ is @'Main'@, @'runArgs'@ are set as process
  -- invocation arguments (as in @argv@) rather than passed directly as a
  -- Haskell function arguments.
  | DebugExecution { Command -> EntryPoint
entryPoint :: EntryPoint, Command -> [FilePath]
runArgs :: [String] }

  -- | Terminate ghc-debugger and exit
  | TerminateProcess

-- | An entry point for program execution.
data EntryPoint = MainEntry { EntryPoint -> Maybe FilePath
mainName :: Maybe String } | FunctionEntry { EntryPoint -> FilePath
fnName :: String }
  deriving (Int -> EntryPoint -> ShowS
[EntryPoint] -> ShowS
EntryPoint -> FilePath
(Int -> EntryPoint -> ShowS)
-> (EntryPoint -> FilePath)
-> ([EntryPoint] -> ShowS)
-> Show EntryPoint
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntryPoint -> ShowS
showsPrec :: Int -> EntryPoint -> ShowS
$cshow :: EntryPoint -> FilePath
show :: EntryPoint -> FilePath
$cshowList :: [EntryPoint] -> ShowS
showList :: [EntryPoint] -> ShowS
Show, (forall x. EntryPoint -> Rep EntryPoint x)
-> (forall x. Rep EntryPoint x -> EntryPoint) -> Generic EntryPoint
forall x. Rep EntryPoint x -> EntryPoint
forall x. EntryPoint -> Rep EntryPoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EntryPoint -> Rep EntryPoint x
from :: forall x. EntryPoint -> Rep EntryPoint x
$cto :: forall x. Rep EntryPoint x -> EntryPoint
to :: forall x. Rep EntryPoint x -> EntryPoint
Generic)

-- | A breakpoint can be set/removed on functions by name, or in modules by
-- line number. And, globally, for all exceptions, or just uncaught exceptions.
data Breakpoint
  = ModuleBreak { Breakpoint -> FilePath
path :: FilePath, Breakpoint -> Int
lineNum :: Int, Breakpoint -> Maybe Int
columnNum :: Maybe Int }
  | FunctionBreak { Breakpoint -> FilePath
function :: String }
  | OnExceptionsBreak
  | OnUncaughtExceptionsBreak
  deriving (Int -> Breakpoint -> ShowS
[Breakpoint] -> ShowS
Breakpoint -> FilePath
(Int -> Breakpoint -> ShowS)
-> (Breakpoint -> FilePath)
-> ([Breakpoint] -> ShowS)
-> Show Breakpoint
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Breakpoint -> ShowS
showsPrec :: Int -> Breakpoint -> ShowS
$cshow :: Breakpoint -> FilePath
show :: Breakpoint -> FilePath
$cshowList :: [Breakpoint] -> ShowS
showList :: [Breakpoint] -> ShowS
Show, (forall x. Breakpoint -> Rep Breakpoint x)
-> (forall x. Rep Breakpoint x -> Breakpoint) -> Generic Breakpoint
forall x. Rep Breakpoint x -> Breakpoint
forall x. Breakpoint -> Rep Breakpoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Breakpoint -> Rep Breakpoint x
from :: forall x. Breakpoint -> Rep Breakpoint x
$cto :: forall x. Rep Breakpoint x -> Breakpoint
to :: forall x. Rep Breakpoint x -> Breakpoint
Generic)

-- | Information about a scope
data ScopeInfo = ScopeInfo
      { ScopeInfo -> ScopeVariablesReference
kind :: ScopeVariablesReference
      , ScopeInfo -> SourceSpan
sourceSpan :: SourceSpan
      , ScopeInfo -> Maybe Int
numVars :: Maybe Int
      , ScopeInfo -> Bool
expensive :: Bool }
  deriving (Int -> ScopeInfo -> ShowS
[ScopeInfo] -> ShowS
ScopeInfo -> FilePath
(Int -> ScopeInfo -> ShowS)
-> (ScopeInfo -> FilePath)
-> ([ScopeInfo] -> ShowS)
-> Show ScopeInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScopeInfo -> ShowS
showsPrec :: Int -> ScopeInfo -> ShowS
$cshow :: ScopeInfo -> FilePath
show :: ScopeInfo -> FilePath
$cshowList :: [ScopeInfo] -> ShowS
showList :: [ScopeInfo] -> ShowS
Show, (forall x. ScopeInfo -> Rep ScopeInfo x)
-> (forall x. Rep ScopeInfo x -> ScopeInfo) -> Generic ScopeInfo
forall x. Rep ScopeInfo x -> ScopeInfo
forall x. ScopeInfo -> Rep ScopeInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScopeInfo -> Rep ScopeInfo x
from :: forall x. ScopeInfo -> Rep ScopeInfo x
$cto :: forall x. Rep ScopeInfo x -> ScopeInfo
to :: forall x. Rep ScopeInfo x -> ScopeInfo
Generic)

data VarFields = LabeledFields [VarInfo]
               | IndexedFields [VarInfo]
               | NoFields
               deriving (Int -> VarFields -> ShowS
[VarFields] -> ShowS
VarFields -> FilePath
(Int -> VarFields -> ShowS)
-> (VarFields -> FilePath)
-> ([VarFields] -> ShowS)
-> Show VarFields
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarFields -> ShowS
showsPrec :: Int -> VarFields -> ShowS
$cshow :: VarFields -> FilePath
show :: VarFields -> FilePath
$cshowList :: [VarFields] -> ShowS
showList :: [VarFields] -> ShowS
Show, (forall x. VarFields -> Rep VarFields x)
-> (forall x. Rep VarFields x -> VarFields) -> Generic VarFields
forall x. Rep VarFields x -> VarFields
forall x. VarFields -> Rep VarFields x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VarFields -> Rep VarFields x
from :: forall x. VarFields -> Rep VarFields x
$cto :: forall x. Rep VarFields x -> VarFields
to :: forall x. Rep VarFields x -> VarFields
Generic, VarFields -> VarFields -> Bool
(VarFields -> VarFields -> Bool)
-> (VarFields -> VarFields -> Bool) -> Eq VarFields
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VarFields -> VarFields -> Bool
== :: VarFields -> VarFields -> Bool
$c/= :: VarFields -> VarFields -> Bool
/= :: VarFields -> VarFields -> Bool
Eq)

-- | Information about a variable
data VarInfo = VarInfo
      { VarInfo -> FilePath
varName  :: String
      , VarInfo -> FilePath
varType  :: String
      , VarInfo -> FilePath
varValue :: String
      , VarInfo -> Bool
isThunk  :: Bool
      , VarInfo -> VariableReference
varRef   :: VariableReference
      -- ^ A reference back to this variable

      , VarInfo -> VarFields
varFields :: VarFields
      -- ^ A 'VarInfo' for each field. These may be named (@Left@) or indexed fields (@Right@).

      -- TODO:
      --  memory reference using ghc-debug.
      }
      deriving (Int -> VarInfo -> ShowS
[VarInfo] -> ShowS
VarInfo -> FilePath
(Int -> VarInfo -> ShowS)
-> (VarInfo -> FilePath) -> ([VarInfo] -> ShowS) -> Show VarInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarInfo -> ShowS
showsPrec :: Int -> VarInfo -> ShowS
$cshow :: VarInfo -> FilePath
show :: VarInfo -> FilePath
$cshowList :: [VarInfo] -> ShowS
showList :: [VarInfo] -> ShowS
Show, (forall x. VarInfo -> Rep VarInfo x)
-> (forall x. Rep VarInfo x -> VarInfo) -> Generic VarInfo
forall x. Rep VarInfo x -> VarInfo
forall x. VarInfo -> Rep VarInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VarInfo -> Rep VarInfo x
from :: forall x. VarInfo -> Rep VarInfo x
$cto :: forall x. Rep VarInfo x -> VarInfo
to :: forall x. Rep VarInfo x -> VarInfo
Generic, VarInfo -> VarInfo -> Bool
(VarInfo -> VarInfo -> Bool)
-> (VarInfo -> VarInfo -> Bool) -> Eq VarInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VarInfo -> VarInfo -> Bool
== :: VarInfo -> VarInfo -> Bool
$c/= :: VarInfo -> VarInfo -> Bool
/= :: VarInfo -> VarInfo -> Bool
Eq)

-- | What kind of breakpoint are we referring to, module or function breakpoints?
-- Used e.g. in the 'ClearBreakpoints' request
data BreakpointKind
  -- | Module breakpoints
  = ModuleBreakpointKind
  -- | Function breakpoints
  | FunctionBreakpointKind
  deriving (Int -> BreakpointKind -> ShowS
[BreakpointKind] -> ShowS
BreakpointKind -> FilePath
(Int -> BreakpointKind -> ShowS)
-> (BreakpointKind -> FilePath)
-> ([BreakpointKind] -> ShowS)
-> Show BreakpointKind
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BreakpointKind -> ShowS
showsPrec :: Int -> BreakpointKind -> ShowS
$cshow :: BreakpointKind -> FilePath
show :: BreakpointKind -> FilePath
$cshowList :: [BreakpointKind] -> ShowS
showList :: [BreakpointKind] -> ShowS
Show, (forall x. BreakpointKind -> Rep BreakpointKind x)
-> (forall x. Rep BreakpointKind x -> BreakpointKind)
-> Generic BreakpointKind
forall x. Rep BreakpointKind x -> BreakpointKind
forall x. BreakpointKind -> Rep BreakpointKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BreakpointKind -> Rep BreakpointKind x
from :: forall x. BreakpointKind -> Rep BreakpointKind x
$cto :: forall x. Rep BreakpointKind x -> BreakpointKind
to :: forall x. Rep BreakpointKind x -> BreakpointKind
Generic, BreakpointKind -> BreakpointKind -> Bool
(BreakpointKind -> BreakpointKind -> Bool)
-> (BreakpointKind -> BreakpointKind -> Bool) -> Eq BreakpointKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BreakpointKind -> BreakpointKind -> Bool
== :: BreakpointKind -> BreakpointKind -> Bool
$c/= :: BreakpointKind -> BreakpointKind -> Bool
/= :: BreakpointKind -> BreakpointKind -> Bool
Eq)

-- | Referring to existing scopes
data ScopeVariablesReference
  = LocalVariablesScope
  | ModuleVariablesScope
  | GlobalVariablesScope
  deriving (Int -> ScopeVariablesReference -> ShowS
[ScopeVariablesReference] -> ShowS
ScopeVariablesReference -> FilePath
(Int -> ScopeVariablesReference -> ShowS)
-> (ScopeVariablesReference -> FilePath)
-> ([ScopeVariablesReference] -> ShowS)
-> Show ScopeVariablesReference
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScopeVariablesReference -> ShowS
showsPrec :: Int -> ScopeVariablesReference -> ShowS
$cshow :: ScopeVariablesReference -> FilePath
show :: ScopeVariablesReference -> FilePath
$cshowList :: [ScopeVariablesReference] -> ShowS
showList :: [ScopeVariablesReference] -> ShowS
Show, (forall x.
 ScopeVariablesReference -> Rep ScopeVariablesReference x)
-> (forall x.
    Rep ScopeVariablesReference x -> ScopeVariablesReference)
-> Generic ScopeVariablesReference
forall x. Rep ScopeVariablesReference x -> ScopeVariablesReference
forall x. ScopeVariablesReference -> Rep ScopeVariablesReference x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScopeVariablesReference -> Rep ScopeVariablesReference x
from :: forall x. ScopeVariablesReference -> Rep ScopeVariablesReference x
$cto :: forall x. Rep ScopeVariablesReference x -> ScopeVariablesReference
to :: forall x. Rep ScopeVariablesReference x -> ScopeVariablesReference
Generic, ScopeVariablesReference -> ScopeVariablesReference -> Bool
(ScopeVariablesReference -> ScopeVariablesReference -> Bool)
-> (ScopeVariablesReference -> ScopeVariablesReference -> Bool)
-> Eq ScopeVariablesReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScopeVariablesReference -> ScopeVariablesReference -> Bool
== :: ScopeVariablesReference -> ScopeVariablesReference -> Bool
$c/= :: ScopeVariablesReference -> ScopeVariablesReference -> Bool
/= :: ScopeVariablesReference -> ScopeVariablesReference -> Bool
Eq, Eq ScopeVariablesReference
Eq ScopeVariablesReference =>
(ScopeVariablesReference -> ScopeVariablesReference -> Ordering)
-> (ScopeVariablesReference -> ScopeVariablesReference -> Bool)
-> (ScopeVariablesReference -> ScopeVariablesReference -> Bool)
-> (ScopeVariablesReference -> ScopeVariablesReference -> Bool)
-> (ScopeVariablesReference -> ScopeVariablesReference -> Bool)
-> (ScopeVariablesReference
    -> ScopeVariablesReference -> ScopeVariablesReference)
-> (ScopeVariablesReference
    -> ScopeVariablesReference -> ScopeVariablesReference)
-> Ord ScopeVariablesReference
ScopeVariablesReference -> ScopeVariablesReference -> Bool
ScopeVariablesReference -> ScopeVariablesReference -> Ordering
ScopeVariablesReference
-> ScopeVariablesReference -> ScopeVariablesReference
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ScopeVariablesReference -> ScopeVariablesReference -> Ordering
compare :: ScopeVariablesReference -> ScopeVariablesReference -> Ordering
$c< :: ScopeVariablesReference -> ScopeVariablesReference -> Bool
< :: ScopeVariablesReference -> ScopeVariablesReference -> Bool
$c<= :: ScopeVariablesReference -> ScopeVariablesReference -> Bool
<= :: ScopeVariablesReference -> ScopeVariablesReference -> Bool
$c> :: ScopeVariablesReference -> ScopeVariablesReference -> Bool
> :: ScopeVariablesReference -> ScopeVariablesReference -> Bool
$c>= :: ScopeVariablesReference -> ScopeVariablesReference -> Bool
>= :: ScopeVariablesReference -> ScopeVariablesReference -> Bool
$cmax :: ScopeVariablesReference
-> ScopeVariablesReference -> ScopeVariablesReference
max :: ScopeVariablesReference
-> ScopeVariablesReference -> ScopeVariablesReference
$cmin :: ScopeVariablesReference
-> ScopeVariablesReference -> ScopeVariablesReference
min :: ScopeVariablesReference
-> ScopeVariablesReference -> ScopeVariablesReference
Ord)

-- | The type of variables referenced, or a particular variable referenced for its fields or value (when inspecting a thunk)
data VariableReference
  -- | A void reference to nothing at all. Used e.g. for ty cons and data cons
  = NoVariables

  -- | Variables in the local context (includes arguments, previous bindings)
  | LocalVariables

  -- | Variables in the module where we're stopped
  | ModuleVariables

  -- | Variables in the global context
  | GlobalVariables

  -- | A reference to a specific variable.
  -- Used to force its result or get its structured children
  | SpecificVariable Int

  deriving (Int -> VariableReference -> ShowS
[VariableReference] -> ShowS
VariableReference -> FilePath
(Int -> VariableReference -> ShowS)
-> (VariableReference -> FilePath)
-> ([VariableReference] -> ShowS)
-> Show VariableReference
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VariableReference -> ShowS
showsPrec :: Int -> VariableReference -> ShowS
$cshow :: VariableReference -> FilePath
show :: VariableReference -> FilePath
$cshowList :: [VariableReference] -> ShowS
showList :: [VariableReference] -> ShowS
Show, (forall x. VariableReference -> Rep VariableReference x)
-> (forall x. Rep VariableReference x -> VariableReference)
-> Generic VariableReference
forall x. Rep VariableReference x -> VariableReference
forall x. VariableReference -> Rep VariableReference x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VariableReference -> Rep VariableReference x
from :: forall x. VariableReference -> Rep VariableReference x
$cto :: forall x. Rep VariableReference x -> VariableReference
to :: forall x. Rep VariableReference x -> VariableReference
Generic, VariableReference -> VariableReference -> Bool
(VariableReference -> VariableReference -> Bool)
-> (VariableReference -> VariableReference -> Bool)
-> Eq VariableReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VariableReference -> VariableReference -> Bool
== :: VariableReference -> VariableReference -> Bool
$c/= :: VariableReference -> VariableReference -> Bool
/= :: VariableReference -> VariableReference -> Bool
Eq, Eq VariableReference
Eq VariableReference =>
(VariableReference -> VariableReference -> Ordering)
-> (VariableReference -> VariableReference -> Bool)
-> (VariableReference -> VariableReference -> Bool)
-> (VariableReference -> VariableReference -> Bool)
-> (VariableReference -> VariableReference -> Bool)
-> (VariableReference -> VariableReference -> VariableReference)
-> (VariableReference -> VariableReference -> VariableReference)
-> Ord VariableReference
VariableReference -> VariableReference -> Bool
VariableReference -> VariableReference -> Ordering
VariableReference -> VariableReference -> VariableReference
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: VariableReference -> VariableReference -> Ordering
compare :: VariableReference -> VariableReference -> Ordering
$c< :: VariableReference -> VariableReference -> Bool
< :: VariableReference -> VariableReference -> Bool
$c<= :: VariableReference -> VariableReference -> Bool
<= :: VariableReference -> VariableReference -> Bool
$c> :: VariableReference -> VariableReference -> Bool
> :: VariableReference -> VariableReference -> Bool
$c>= :: VariableReference -> VariableReference -> Bool
>= :: VariableReference -> VariableReference -> Bool
$cmax :: VariableReference -> VariableReference -> VariableReference
max :: VariableReference -> VariableReference -> VariableReference
$cmin :: VariableReference -> VariableReference -> VariableReference
min :: VariableReference -> VariableReference -> VariableReference
Ord)

instance Bounded VariableReference where
  minBound :: VariableReference
minBound = VariableReference
NoVariables
  maxBound :: VariableReference
maxBound = Int -> VariableReference
SpecificVariable Int
forall a. Bounded a => a
maxBound

instance Enum VariableReference where
  toEnum :: Int -> VariableReference
toEnum Int
0 = VariableReference
NoVariables
  toEnum Int
1 = VariableReference
LocalVariables
  toEnum Int
2 = VariableReference
ModuleVariables
  toEnum Int
3 = VariableReference
GlobalVariables
  toEnum Int
n = Int -> VariableReference
SpecificVariable (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)

  fromEnum :: VariableReference -> Int
fromEnum VariableReference
NoVariables          = Int
0
  fromEnum VariableReference
LocalVariables       = Int
1
  fromEnum VariableReference
ModuleVariables      = Int
2
  fromEnum VariableReference
GlobalVariables      = Int
3
  fromEnum (SpecificVariable Int
n) = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n

-- | A source span type for the interface. Like 'RealSrcSpan'.
data SourceSpan = SourceSpan
      { SourceSpan -> FilePath
file :: !FilePath
      -- ^ Path to file where this span is located
      , SourceSpan -> Int
startLine :: {-# UNPACK #-} !Int
      -- ^ RealSrcSpan start line
      , SourceSpan -> Int
endLine :: {-# UNPACK #-} !Int
      -- ^ RealSrcSpan end line
      , SourceSpan -> Int
startCol :: {-# UNPACK #-} !Int
      -- ^ RealSrcSpan start col
      , SourceSpan -> Int
endCol :: {-# UNPACK #-} !Int
      -- ^ RealSrcSpan end col
      }
      deriving (Int -> SourceSpan -> ShowS
[SourceSpan] -> ShowS
SourceSpan -> FilePath
(Int -> SourceSpan -> ShowS)
-> (SourceSpan -> FilePath)
-> ([SourceSpan] -> ShowS)
-> Show SourceSpan
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceSpan -> ShowS
showsPrec :: Int -> SourceSpan -> ShowS
$cshow :: SourceSpan -> FilePath
show :: SourceSpan -> FilePath
$cshowList :: [SourceSpan] -> ShowS
showList :: [SourceSpan] -> ShowS
Show, (forall x. SourceSpan -> Rep SourceSpan x)
-> (forall x. Rep SourceSpan x -> SourceSpan) -> Generic SourceSpan
forall x. Rep SourceSpan x -> SourceSpan
forall x. SourceSpan -> Rep SourceSpan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SourceSpan -> Rep SourceSpan x
from :: forall x. SourceSpan -> Rep SourceSpan x
$cto :: forall x. Rep SourceSpan x -> SourceSpan
to :: forall x. Rep SourceSpan x -> SourceSpan
Generic)

--------------------------------------------------------------------------------
-- Responses
--------------------------------------------------------------------------------

-- | The responses sent by `ghc-debugger` to the client
data Response
  = DidEval EvalResult
  | DidSetBreakpoint BreakFound
  | DidRemoveBreakpoint BreakFound
  | DidGetBreakpoints (Maybe SourceSpan)
  | DidClearBreakpoints
  | DidContinue EvalResult
  | DidStep EvalResult
  | DidExec EvalResult
  | GotStacktrace [StackFrame]
  | GotScopes [ScopeInfo]
  | GotVariables (Either VarInfo [VarInfo])
  | Aborted String
  | Initialised

data BreakFound
  = BreakFound
    { BreakFound -> Bool
changed :: !Bool
    -- ^ Did the status of the found breakpoint change?
    , BreakFound -> BreakpointId
breakId :: GHC.BreakpointId
    -- ^ Internal breakpoint identifier (module + ix) (TODO: Don't expose GHC)
    , BreakFound -> SourceSpan
sourceSpan :: SourceSpan
    -- ^ Source span for interface
    }
  -- | Breakpoint found but without location info.
  -- This happens when setting breakpoints on exceptions.
  | BreakFoundNoLoc
    { changed :: Bool }
  -- | No breakpoints found
  | BreakNotFound
  -- | Found many breakpoints.
  -- Caused by setting breakpoint on a name with multiple matches or many equations.
  | ManyBreaksFound [BreakFound]
  deriving (Int -> BreakFound -> ShowS
[BreakFound] -> ShowS
BreakFound -> FilePath
(Int -> BreakFound -> ShowS)
-> (BreakFound -> FilePath)
-> ([BreakFound] -> ShowS)
-> Show BreakFound
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BreakFound -> ShowS
showsPrec :: Int -> BreakFound -> ShowS
$cshow :: BreakFound -> FilePath
show :: BreakFound -> FilePath
$cshowList :: [BreakFound] -> ShowS
showList :: [BreakFound] -> ShowS
Show, (forall x. BreakFound -> Rep BreakFound x)
-> (forall x. Rep BreakFound x -> BreakFound) -> Generic BreakFound
forall x. Rep BreakFound x -> BreakFound
forall x. BreakFound -> Rep BreakFound x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BreakFound -> Rep BreakFound x
from :: forall x. BreakFound -> Rep BreakFound x
$cto :: forall x. Rep BreakFound x -> BreakFound
to :: forall x. Rep BreakFound x -> BreakFound
Generic)

data EvalResult
  = EvalCompleted { EvalResult -> FilePath
resultVal :: String, EvalResult -> FilePath
resultType :: String }
  | EvalException { resultVal :: String, resultType :: String }
  | EvalStopped   { EvalResult -> Maybe BreakpointId
breakId :: Maybe GHC.BreakpointId {-^ Did we stop at an exception (@Nothing@) or at a breakpoint (@Just@)? -} }
  -- | Evaluation failed for some reason other than completed/completed-with-exception/stopped.
  | EvalAbortedWith String
  deriving (Int -> EvalResult -> ShowS
[EvalResult] -> ShowS
EvalResult -> FilePath
(Int -> EvalResult -> ShowS)
-> (EvalResult -> FilePath)
-> ([EvalResult] -> ShowS)
-> Show EvalResult
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EvalResult -> ShowS
showsPrec :: Int -> EvalResult -> ShowS
$cshow :: EvalResult -> FilePath
show :: EvalResult -> FilePath
$cshowList :: [EvalResult] -> ShowS
showList :: [EvalResult] -> ShowS
Show, (forall x. EvalResult -> Rep EvalResult x)
-> (forall x. Rep EvalResult x -> EvalResult) -> Generic EvalResult
forall x. Rep EvalResult x -> EvalResult
forall x. EvalResult -> Rep EvalResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EvalResult -> Rep EvalResult x
from :: forall x. EvalResult -> Rep EvalResult x
$cto :: forall x. Rep EvalResult x -> EvalResult
to :: forall x. Rep EvalResult x -> EvalResult
Generic)

data StackFrame
  = StackFrame
    { StackFrame -> FilePath
name :: String
    -- ^ Title of stack frame
    , StackFrame -> SourceSpan
sourceSpan :: SourceSpan
    -- ^ Source span for this stack frame
    }
  deriving (Int -> StackFrame -> ShowS
[StackFrame] -> ShowS
StackFrame -> FilePath
(Int -> StackFrame -> ShowS)
-> (StackFrame -> FilePath)
-> ([StackFrame] -> ShowS)
-> Show StackFrame
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StackFrame -> ShowS
showsPrec :: Int -> StackFrame -> ShowS
$cshow :: StackFrame -> FilePath
show :: StackFrame -> FilePath
$cshowList :: [StackFrame] -> ShowS
showList :: [StackFrame] -> ShowS
Show, (forall x. StackFrame -> Rep StackFrame x)
-> (forall x. Rep StackFrame x -> StackFrame) -> Generic StackFrame
forall x. Rep StackFrame x -> StackFrame
forall x. StackFrame -> Rep StackFrame x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StackFrame -> Rep StackFrame x
from :: forall x. StackFrame -> Rep StackFrame x
$cto :: forall x. Rep StackFrame x -> StackFrame
to :: forall x. Rep StackFrame x -> StackFrame
Generic)

--------------------------------------------------------------------------------
-- Instances
--------------------------------------------------------------------------------

deriving instance Show Command
deriving instance Generic Command

deriving instance Show Response
deriving instance Generic Response

instance ToJSON Command    where toEncoding :: Command -> Encoding
toEncoding = Options -> Command -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance ToJSON Breakpoint where toEncoding :: Breakpoint -> Encoding
toEncoding = Options -> Breakpoint -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance ToJSON BreakpointKind where toEncoding :: BreakpointKind -> Encoding
toEncoding = Options -> BreakpointKind -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance ToJSON ScopeVariablesReference where toEncoding :: ScopeVariablesReference -> Encoding
toEncoding = Options -> ScopeVariablesReference -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance ToJSON VariableReference where toEncoding :: VariableReference -> Encoding
toEncoding = Options -> VariableReference -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance ToJSON Response   where toEncoding :: Response -> Encoding
toEncoding = Options -> Response -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance ToJSON EvalResult where toEncoding :: EvalResult -> Encoding
toEncoding = Options -> EvalResult -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance ToJSON BreakFound where toEncoding :: BreakFound -> Encoding
toEncoding = Options -> BreakFound -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance ToJSON SourceSpan where toEncoding :: SourceSpan -> Encoding
toEncoding = Options -> SourceSpan -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance ToJSON EntryPoint where toEncoding :: EntryPoint -> Encoding
toEncoding = Options -> EntryPoint -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance ToJSON StackFrame where toEncoding :: StackFrame -> Encoding
toEncoding = Options -> StackFrame -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance ToJSON ScopeInfo  where toEncoding :: ScopeInfo -> Encoding
toEncoding = Options -> ScopeInfo -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance ToJSON VarInfo    where toEncoding :: VarInfo -> Encoding
toEncoding = Options -> VarInfo -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance ToJSON VarFields where toEncoding :: VarFields -> Encoding
toEncoding = Options -> VarFields -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

instance FromJSON Command
instance FromJSON Breakpoint
instance FromJSON BreakpointKind
instance FromJSON ScopeVariablesReference
instance FromJSON VariableReference
instance FromJSON Response
instance FromJSON EvalResult
instance FromJSON BreakFound
instance FromJSON SourceSpan
instance FromJSON EntryPoint
instance FromJSON StackFrame
instance FromJSON ScopeInfo
instance FromJSON VarInfo
instance FromJSON VarFields

instance Show GHC.BreakpointId where
  show :: BreakpointId -> FilePath
show (GHC.BreakpointId Module
m Int
ix) = FilePath
"BreakpointId " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Module -> FilePath
forall a. Outputable a => a -> FilePath
GHC.showPprUnsafe Module
m FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
ix

instance ToJSON GHC.BreakpointId where
  toJSON :: BreakpointId -> Value
toJSON (GHC.BreakpointId (Module Unit
unit ModuleName
mn) Int
ix) =
    [Pair] -> Value
object [ Key
"module_name" Key -> FilePath -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ModuleName -> FilePath
moduleNameString ModuleName
mn
           , Key
"module_unit" Key -> FilePath -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Unit -> FilePath
forall u. IsUnitId u => u -> FilePath
unitString Unit
unit
           , Key
"ix" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
ix
           ]
instance FromJSON GHC.BreakpointId where
  parseJSON :: Value -> Parser BreakpointId
parseJSON = FilePath
-> (Object -> Parser BreakpointId) -> Value -> Parser BreakpointId
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject FilePath
"BreakpointId" ((Object -> Parser BreakpointId) -> Value -> Parser BreakpointId)
-> (Object -> Parser BreakpointId) -> Value -> Parser BreakpointId
forall a b. (a -> b) -> a -> b
$ \Object
v -> Module -> Int -> BreakpointId
GHC.BreakpointId
        (Module -> Int -> BreakpointId)
-> Parser Module -> Parser (Int -> BreakpointId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Unit -> ModuleName -> Module
forall unit. unit -> ModuleName -> GenModule unit
Module (Unit -> ModuleName -> Module)
-> Parser Unit -> Parser (ModuleName -> Module)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> Unit
stringToUnit (FilePath -> Unit) -> Parser FilePath -> Parser Unit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser FilePath
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"module_unit") Parser (ModuleName -> Module) -> Parser ModuleName -> Parser Module
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FilePath -> ModuleName
mkModuleName (FilePath -> ModuleName) -> Parser FilePath -> Parser ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser FilePath
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"module_name"))
        Parser (Int -> BreakpointId) -> Parser Int -> Parser BreakpointId
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ix"