From 7bae5c45aff4f84b8436f1a799a901722cb3f51e Mon Sep 17 00:00:00 2001 From: Rodrigo Mesquita Date: Thu, 30 Oct 2025 15:27:43 +0000 Subject: [PATCH 1/3] feat: Return structured variables for evaluate var Leverages DAP feature of returning structured variable reference rather than the evaluation string when the evaluate request is for a single variable. This is useful in the Watch context and for interactive exploration in the REPL, besides the variables pane. `show ` or `print ` can be used to reproduce the old behavior of printing the variable value whole. Fixes #116 Fixes #108 --- haskell-debugger/GHC/Debugger/Breakpoint.hs | 1 - .../GHC/Debugger/Breakpoint/Map.hs | 8 +-- haskell-debugger/GHC/Debugger/Evaluation.hs | 1 - .../GHC/Debugger/Interface/Messages.hs | 11 ++- haskell-debugger/GHC/Debugger/Monad.hs | 1 - hdb/Development/Debug/Adapter/Evaluation.hs | 70 ++++++++++++------- hdb/Development/Debug/Adapter/Stopped.hs | 11 --- 7 files changed, 60 insertions(+), 43 deletions(-) diff --git a/haskell-debugger/GHC/Debugger/Breakpoint.hs b/haskell-debugger/GHC/Debugger/Breakpoint.hs index c068dd4..e215be8 100644 --- a/haskell-debugger/GHC/Debugger/Breakpoint.hs +++ b/haskell-debugger/GHC/Debugger/Breakpoint.hs @@ -17,7 +17,6 @@ import GHC.Driver.Env import GHC.Driver.Ppr as GHC import GHC.Runtime.Debugger.Breakpoints as GHC import GHC.Utils.Outputable as GHC -import GHC.Utils.Trace import GHC.Debugger.Monad import GHC.Debugger.Session diff --git a/haskell-debugger/GHC/Debugger/Breakpoint/Map.hs b/haskell-debugger/GHC/Debugger/Breakpoint/Map.hs index 4ddbc7f..b9b8848 100644 --- a/haskell-debugger/GHC/Debugger/Breakpoint/Map.hs +++ b/haskell-debugger/GHC/Debugger/Breakpoint/Map.hs @@ -66,14 +66,14 @@ lookupModuleIBIs m (BreakpointMap bm) = keys :: BreakpointMap a -> [InternalBreakpointId] keys (BreakpointMap bm) = - [ InternalBreakpointId mod bix - | (mod, im) <- moduleEnvToList bm + [ InternalBreakpointId m bix + | (m, im) <- moduleEnvToList bm , bix <- IM.keys im ] toList :: BreakpointMap a -> [(InternalBreakpointId, a)] toList (BreakpointMap bm) = - [ (InternalBreakpointId mod bix, a) - | (mod, im) <- moduleEnvToList bm + [ (InternalBreakpointId m bix, a) + | (m, im) <- moduleEnvToList bm , (bix, a) <- IM.toList im ] diff --git a/haskell-debugger/GHC/Debugger/Evaluation.hs b/haskell-debugger/GHC/Debugger/Evaluation.hs index 68eb52e..058cbd9 100644 --- a/haskell-debugger/GHC/Debugger/Evaluation.hs +++ b/haskell-debugger/GHC/Debugger/Evaluation.hs @@ -23,7 +23,6 @@ import System.Directory import qualified Prettyprinter as Pretty import GHC -import GHC.Utils.Trace import GHC.Builtin.Names (gHC_INTERNAL_GHCI_HELPERS) import GHC.Unit.Types import GHC.Data.FastString diff --git a/haskell-debugger/GHC/Debugger/Interface/Messages.hs b/haskell-debugger/GHC/Debugger/Interface/Messages.hs index 34c638c..773185f 100644 --- a/haskell-debugger/GHC/Debugger/Interface/Messages.hs +++ b/haskell-debugger/GHC/Debugger/Interface/Messages.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE DeriveGeneric, +{-# LANGUAGE LambdaCase, + DeriveGeneric, StandaloneDeriving, OverloadedStrings, DuplicateRecordFields, @@ -161,6 +162,14 @@ data VariableReference deriving (Show, Generic, Eq, Ord) +-- | From 'ScopeVariablesReference' to a 'VariableReference' that can be used in @"variable"@ requests +scopeToVarRef :: ScopeVariablesReference -> VariableReference +scopeToVarRef = \case + LocalVariablesScope -> LocalVariables + ModuleVariablesScope -> ModuleVariables + GlobalVariablesScope -> GlobalVariables + + instance Bounded VariableReference where minBound = NoVariables maxBound = SpecificVariable maxBound diff --git a/haskell-debugger/GHC/Debugger/Monad.hs b/haskell-debugger/GHC/Debugger/Monad.hs index 45ac056..bf144df 100644 --- a/haskell-debugger/GHC/Debugger/Monad.hs +++ b/haskell-debugger/GHC/Debugger/Monad.hs @@ -28,7 +28,6 @@ import qualified GHCi.BreakArray as BA import GHC.Driver.DynFlags as GHC import GHC.Unit.Module.ModSummary as GHC import GHC.Utils.Outputable as GHC -import GHC.Utils.Trace as GHC import GHC.Utils.Logger as GHC import GHC.Types.Unique.Supply as GHC import GHC.Runtime.Loader as GHC diff --git a/hdb/Development/Debug/Adapter/Evaluation.hs b/hdb/Development/Debug/Adapter/Evaluation.hs index f9b52d2..944a5a9 100644 --- a/hdb/Development/Debug/Adapter/Evaluation.hs +++ b/hdb/Development/Debug/Adapter/Evaluation.hs @@ -1,6 +1,7 @@ {-# LANGUAGE RecordWildCards, OverloadedRecordDot, DuplicateRecordFields #-} module Development.Debug.Adapter.Evaluation where +import Control.Monad import qualified Data.Text as T import qualified Data.Map as M import qualified Data.IntSet as IS @@ -36,32 +37,53 @@ startExecution = do -- | Command for evaluation (includes evaluation-on-hover) commandEvaluate :: DebugAdaptor () commandEvaluate = do - EvaluateArguments {..} <- getArguments - DidEval er <- sendSync (DoEval (T.unpack evaluateArgumentsExpression)) - case er of - EvalStopped{} -> error "impossible, execution is resumed automatically for 'DoEval'" - EvalAbortedWith e -> do - -- Evaluation failed, we report it but don't terminate. - sendEvaluateResponse EvaluateResponse - { evaluateResponseResult = T.pack e - , evaluateResponseType = T.pack "" - , evaluateResponsePresentationHint = Nothing - , evaluateResponseVariablesReference = 0 - , evaluateResponseNamedVariables = Nothing - , evaluateResponseIndexedVariables = Nothing - , evaluateResponseMemoryReference = Nothing - } - _ -> do - sendEvaluateResponse EvaluateResponse - { evaluateResponseResult = T.pack $ resultVal er - , evaluateResponseType = T.pack $ resultType er - , evaluateResponsePresentationHint = Nothing - , evaluateResponseVariablesReference = 0 - , evaluateResponseNamedVariables = Nothing - , evaluateResponseIndexedVariables = Nothing - , evaluateResponseMemoryReference = Nothing + EvaluateArguments {evaluateArgumentsFrameId=_todo, ..} <- getArguments + -- TODO: Proper support for threads/stack frames/scopes id. + -- Currently: ignore `evaluateArgumentsFrameId` and always use instead: + + let notAVarResp res ty = EvaluateResponse + { evaluateResponseResult = res + , evaluateResponseType = ty + , evaluateResponsePresentationHint = Nothing + , evaluateResponseVariablesReference = 0 + , evaluateResponseNamedVariables = Nothing + , evaluateResponseIndexedVariables = Nothing + , evaluateResponseMemoryReference = Nothing } + -- Only evaluate expression if it is not a variable found in the given `evaluateArgumentsFrameId` + let doEvaluate = do + DidEval er <- sendSync (DoEval (T.unpack evaluateArgumentsExpression)) + case er of + EvalStopped{} -> error "impossible, execution is resumed automatically for 'DoEval'" + EvalAbortedWith e -> do + -- Evaluation failed, we report it but don't terminate. + sendEvaluateResponse (notAVarResp (T.pack e) (T.pack "")) + _ -> do + sendEvaluateResponse (notAVarResp (T.pack $ resultVal er) (T.pack $ resultType er)) + + -- Shortcut. Single word expression may be variable in scope (#116) + case T.words evaluateArgumentsExpression of + [possiblyVar] -> do + GotScopes scopes <- sendSync (GetScopes {-todo: use evaluateArgumentsFrameId-}) + foundVars <- forM (filter (not . expensive) scopes) $ \scope -> do + GotVariables vars <- sendSync (GetVariables (scopeToVarRef scope.kind)) + return (either (:[]) id vars) + case filter ((==possiblyVar) . T.pack . (.varName)) (concat foundVars) of + foundOne:_ -> -- found it! + sendEvaluateResponse EvaluateResponse + { evaluateResponseResult = T.pack foundOne.varValue + , evaluateResponseType = T.pack foundOne.varType + , evaluateResponsePresentationHint = Nothing + , evaluateResponseVariablesReference = fromEnum foundOne.varRef + , evaluateResponseNamedVariables = Nothing + , evaluateResponseIndexedVariables = Nothing + , evaluateResponseMemoryReference = Nothing + } + [] -> doEvaluate + _ -> doEvaluate + + -------------------------------------------------------------------------------- -- * Utils -------------------------------------------------------------------------------- diff --git a/hdb/Development/Debug/Adapter/Stopped.hs b/hdb/Development/Debug/Adapter/Stopped.hs index 55fdd49..02607b3 100644 --- a/hdb/Development/Debug/Adapter/Stopped.hs +++ b/hdb/Development/Debug/Adapter/Stopped.hs @@ -153,14 +153,3 @@ varInfoToVariables VarInfo{..} = } } --------------------------------------------------------------------------------- --- * Utilities --------------------------------------------------------------------------------- - --- | From 'ScopeVariablesReference' to a 'VariableReference' that can be used in @"variable"@ requests -scopeToVarRef :: ScopeVariablesReference -> VariableReference -scopeToVarRef = \case - LocalVariablesScope -> LocalVariables - ModuleVariablesScope -> ModuleVariables - GlobalVariablesScope -> GlobalVariables - From 83fa7cef59b50c94ace0e5606116444bd735d87d Mon Sep 17 00:00:00 2001 From: Rodrigo Mesquita Date: Thu, 30 Oct 2025 15:58:30 +0000 Subject: [PATCH 2/3] feat: Return structured result for all evaluation In the previous commit we used a contrived approach to returning a structured representation for only variables which were evaluated. However, we can go further and (even more easily/uniformly!) display all evaluated expressions in their structured form. The unstructured form can still be gotten by `show` or `print` (In fact, all expressions evaluated end up being `print`ed to stdout so you see them currently, besides the structured representation, even without manually printing them). Fixes #116 BETTER --- haskell-debugger/GHC/Debugger/Evaluation.hs | 5 +- .../GHC/Debugger/Interface/Messages.hs | 8 ++- haskell-debugger/GHC/Debugger/Utils.hs | 13 +++-- hdb/Development/Debug/Adapter/Evaluation.hs | 55 +++++++------------ test/golden/T61/T61.hdb-stdout | 2 +- test/golden/T79/T79.hdb-stdout | 2 +- test/golden/T83/T83.hdb-stdout | 2 +- 7 files changed, 41 insertions(+), 46 deletions(-) diff --git a/haskell-debugger/GHC/Debugger/Evaluation.hs b/haskell-debugger/GHC/Debugger/Evaluation.hs index 058cbd9..15e17a8 100644 --- a/haskell-debugger/GHC/Debugger/Evaluation.hs +++ b/haskell-debugger/GHC/Debugger/Evaluation.hs @@ -192,9 +192,10 @@ handleExecResult = \case ExecComplete {execResult} -> do case execResult of Left e -> return (EvalException (show e) "SomeException") - Right [] -> return (EvalCompleted "" "") -- Evaluation completed without binding any result. + Right [] -> return (EvalCompleted "" "" NoVariables) -- Evaluation completed without binding any result. Right (n:_ns) -> inspectName n >>= \case - Just VarInfo{varValue, varType} -> return (EvalCompleted varValue varType) + Just VarInfo{varValue, varType, varRef} -> do + return (EvalCompleted varValue varType varRef) Nothing -> liftIO $ fail "doEval failed" ExecBreak {breakNames = _, breakPointId = Nothing} -> -- Stopped at an exception diff --git a/haskell-debugger/GHC/Debugger/Interface/Messages.hs b/haskell-debugger/GHC/Debugger/Interface/Messages.hs index 773185f..2afdb79 100644 --- a/haskell-debugger/GHC/Debugger/Interface/Messages.hs +++ b/haskell-debugger/GHC/Debugger/Interface/Messages.hs @@ -243,7 +243,13 @@ data BreakFound deriving (Show, Generic) data EvalResult - = EvalCompleted { resultVal :: String, resultType :: String } + = EvalCompleted { resultVal :: String + , resultType :: String + , resultStructureRef :: VariableReference + -- ^ A structured representation of the result of evaluating + -- the expression given as a "virtual" 'VariableReference' + -- that the user can expand as a normal variable. + } | EvalException { resultVal :: String, resultType :: String } | EvalStopped { breakId :: Maybe GHC.InternalBreakpointId {-^ Did we stop at an exception (@Nothing@) or at a breakpoint (@Just@)? -} } -- | Evaluation failed for some reason other than completed/completed-with-exception/stopped. diff --git a/haskell-debugger/GHC/Debugger/Utils.hs b/haskell-debugger/GHC/Debugger/Utils.hs index d36304a..1cf331d 100644 --- a/haskell-debugger/GHC/Debugger/Utils.hs +++ b/haskell-debugger/GHC/Debugger/Utils.hs @@ -1,13 +1,18 @@ {-# LANGUAGE CPP, NamedFieldPuns, TupleSections, LambdaCase, DuplicateRecordFields, RecordWildCards, TupleSections, ViewPatterns, TypeApplications, ScopedTypeVariables, BangPatterns #-} -module GHC.Debugger.Utils where +module GHC.Debugger.Utils + ( module GHC.Debugger.Utils + , module GHC.Utils.Outputable + , module GHC.Utils.Trace + ) where import GHC import GHC.Data.FastString -import GHC.Driver.DynFlags as GHC -import GHC.Driver.Ppr as GHC -import GHC.Utils.Outputable as GHC +import GHC.Driver.DynFlags +import GHC.Driver.Ppr +import GHC.Utils.Outputable +import GHC.Utils.Trace import GHC.Debugger.Monad import GHC.Debugger.Interface.Messages diff --git a/hdb/Development/Debug/Adapter/Evaluation.hs b/hdb/Development/Debug/Adapter/Evaluation.hs index 944a5a9..dc350ff 100644 --- a/hdb/Development/Debug/Adapter/Evaluation.hs +++ b/hdb/Development/Debug/Adapter/Evaluation.hs @@ -1,7 +1,6 @@ {-# LANGUAGE RecordWildCards, OverloadedRecordDot, DuplicateRecordFields #-} module Development.Debug.Adapter.Evaluation where -import Control.Monad import qualified Data.Text as T import qualified Data.Map as M import qualified Data.IntSet as IS @@ -38,10 +37,8 @@ startExecution = do commandEvaluate :: DebugAdaptor () commandEvaluate = do EvaluateArguments {evaluateArgumentsFrameId=_todo, ..} <- getArguments - -- TODO: Proper support for threads/stack frames/scopes id. - -- Currently: ignore `evaluateArgumentsFrameId` and always use instead: - let notAVarResp res ty = EvaluateResponse + let simpleEvalResp res ty = EvaluateResponse { evaluateResponseResult = res , evaluateResponseType = ty , evaluateResponsePresentationHint = Nothing @@ -51,38 +48,24 @@ commandEvaluate = do , evaluateResponseMemoryReference = Nothing } - -- Only evaluate expression if it is not a variable found in the given `evaluateArgumentsFrameId` - let doEvaluate = do - DidEval er <- sendSync (DoEval (T.unpack evaluateArgumentsExpression)) - case er of - EvalStopped{} -> error "impossible, execution is resumed automatically for 'DoEval'" - EvalAbortedWith e -> do - -- Evaluation failed, we report it but don't terminate. - sendEvaluateResponse (notAVarResp (T.pack e) (T.pack "")) - _ -> do - sendEvaluateResponse (notAVarResp (T.pack $ resultVal er) (T.pack $ resultType er)) - - -- Shortcut. Single word expression may be variable in scope (#116) - case T.words evaluateArgumentsExpression of - [possiblyVar] -> do - GotScopes scopes <- sendSync (GetScopes {-todo: use evaluateArgumentsFrameId-}) - foundVars <- forM (filter (not . expensive) scopes) $ \scope -> do - GotVariables vars <- sendSync (GetVariables (scopeToVarRef scope.kind)) - return (either (:[]) id vars) - case filter ((==possiblyVar) . T.pack . (.varName)) (concat foundVars) of - foundOne:_ -> -- found it! - sendEvaluateResponse EvaluateResponse - { evaluateResponseResult = T.pack foundOne.varValue - , evaluateResponseType = T.pack foundOne.varType - , evaluateResponsePresentationHint = Nothing - , evaluateResponseVariablesReference = fromEnum foundOne.varRef - , evaluateResponseNamedVariables = Nothing - , evaluateResponseIndexedVariables = Nothing - , evaluateResponseMemoryReference = Nothing - } - [] -> doEvaluate - _ -> doEvaluate - + DidEval er <- sendSync (DoEval (T.unpack evaluateArgumentsExpression)) + case er of + EvalStopped{} -> error "impossible, execution is resumed automatically for 'DoEval'" + EvalAbortedWith e -> + -- Evaluation failed, we report it but don't terminate. + sendEvaluateResponse (simpleEvalResp (T.pack e) (T.pack "")) + EvalException {resultVal, resultType} -> + sendEvaluateResponse (simpleEvalResp (T.pack resultVal) (T.pack resultType)) + EvalCompleted{resultVal, resultType, resultStructureRef} -> do + sendEvaluateResponse EvaluateResponse + { evaluateResponseResult = T.pack resultVal + , evaluateResponseType = T.pack resultType + , evaluateResponsePresentationHint = Nothing + , evaluateResponseVariablesReference = fromEnum resultStructureRef + , evaluateResponseNamedVariables = Nothing + , evaluateResponseIndexedVariables = Nothing + , evaluateResponseMemoryReference = Nothing + } -------------------------------------------------------------------------------- -- * Utils diff --git a/test/golden/T61/T61.hdb-stdout b/test/golden/T61/T61.hdb-stdout index 1edc519..06fb912 100644 --- a/test/golden/T61/T61.hdb-stdout +++ b/test/golden/T61/T61.hdb-stdout @@ -1,4 +1,4 @@ [1 of 2] Compiling Main ( /x/Main.hs, interpreted )[main] (hdb) wrks -EvalCompleted {resultVal = "()", resultType = "()"} +EvalCompleted {resultVal = "()", resultType = "()", resultStructureRef = NoVariables} (hdb) Exiting... diff --git a/test/golden/T79/T79.hdb-stdout b/test/golden/T79/T79.hdb-stdout index 3f16f44..75a316b 100644 --- a/test/golden/T79/T79.hdb-stdout +++ b/test/golden/T79/T79.hdb-stdout @@ -9,5 +9,5 @@ [1 of 2] Compiling Main ( -tmp] (hdb) Hello, Haskell! -EvalCompleted {resultVal = "()", resultType = "()"} +EvalCompleted {resultVal = "()", resultType = "()", resultStructureRef = NoVariables} (hdb) \ No newline at end of file diff --git a/test/golden/T83/T83.hdb-stdout b/test/golden/T83/T83.hdb-stdout index 7181372..ca0d958 100644 --- a/test/golden/T83/T83.hdb-stdout +++ b/test/golden/T83/T83.hdb-stdout @@ -1,4 +1,4 @@ [1 of 2] Compiling Main ( /Main.hs, interpreted )[main] (hdb) Heli -EvalCompleted {resultVal = "()", resultType = "()"} +EvalCompleted {resultVal = "()", resultType = "()", resultStructureRef = NoVariables} (hdb) Exiting... From daec6774c41ccfb9e7a17ddbb361edecbdc0e489 Mon Sep 17 00:00:00 2001 From: Rodrigo Mesquita Date: Thu, 30 Oct 2025 16:19:31 +0000 Subject: [PATCH 3/3] Add test for #116 --- test/integration-tests/data/T116/T116.hs | 22 +++++++++++++++++ test/integration-tests/test/adapter.test.ts | 26 ++++++++++++++++++++- 2 files changed, 47 insertions(+), 1 deletion(-) create mode 100644 test/integration-tests/data/T116/T116.hs diff --git a/test/integration-tests/data/T116/T116.hs b/test/integration-tests/data/T116/T116.hs new file mode 100644 index 0000000..769124e --- /dev/null +++ b/test/integration-tests/data/T116/T116.hs @@ -0,0 +1,22 @@ +module Main where + +import Data.IntMap +import qualified Data.IntMap as IM + +main = do + nn (IM.fromList [(0,345),(1,34),(46,345)]) + nn (IM.fromList [(0,1)]) + nn (IM.fromList [(0,2), (2,4)]) + nn (IM.fromList [(0,3)]) + +nn :: IntMap Int -> IO () +nn im = do + if False + then return () + else do + nnn im + return () + +nnn :: IntMap Int -> IO () +nnn im = do + const (return ()) im diff --git a/test/integration-tests/test/adapter.test.ts b/test/integration-tests/test/adapter.test.ts index 210e4f0..2887c45 100644 --- a/test/integration-tests/test/adapter.test.ts +++ b/test/integration-tests/test/adapter.test.ts @@ -204,7 +204,7 @@ describe("Debug Adapter Tests", function () { return forcedVar } - const expandVar = async (v) => { + const expandVar = async (v : {variablesReference: number, name: string}) => { assert.notStrictEqual(v.variablesReference, 0, `Variable ${v.name} should be expandable (because it is a structure)`); // Expand a structure (similarly to forcing a lazy variable, but because it is not lazy it will fetch the fields) @@ -857,5 +857,29 @@ describe("Debug Adapter Tests", function () { })) }) }) + describe("Evaluate", function () { + it("Return structured representation for evaluated expressions (issue #116)", async () => { + let config = mkConfig({ + projectRoot: "/data/T116", + entryFile: "T116.hs", + entryPoint: "main", + entryArgs: [], + extraGhcArgs: [] + }) + + const expected = { path: config.projectRoot + "/" + config.entryFile, line: 13 } + + await dc.hitBreakpoint(config, { path: config.entryFile, line: 13 }, expected, expected); + + let resp = await dc.evaluateRequest({expression: "IM.delete 0 (IM.insert 0 'a' (IM.insert 1 'b' IM.empty))"} ) + + assert.strictEqual(resp.body.result, 'Tip'); + const respChild = await expandVar({...resp.body, name: resp.body.result}) + const _1Var = await respChild.get("_1") + const _2Var = await respChild.get("_2") + assert.strictEqual(_1Var.value, '1'); + assert.strictEqual(_2Var.value, '\'b\''); + }) + }) })