Structured representation for Eval

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

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
   ]

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
@@ -193,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

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
@@ -234,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.

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

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

hdb/Development/Debug/Adapter/Evaluation.hs

@@ -36,30 +36,35 @@ startExecution = do
 -- | Command for evaluation (includes evaluation-on-hover)
 commandEvaluate :: DebugAdaptor ()
 commandEvaluate = do
-  EvaluateArguments {..} <- getArguments
+  EvaluateArguments {evaluateArgumentsFrameId=_todo, ..} <- getArguments
+
+  let simpleEvalResp res ty = EvaluateResponse
+        { evaluateResponseResult             = res
+        , evaluateResponseType               = ty
+        , evaluateResponsePresentationHint   = Nothing
+        , evaluateResponseVariablesReference = 0
+        , evaluateResponseNamedVariables     = Nothing
+        , evaluateResponseIndexedVariables   = Nothing
+        , evaluateResponseMemoryReference    = Nothing
+        }
+
   DidEval er <- sendSync (DoEval (T.unpack evaluateArgumentsExpression))
   case er of
     EvalStopped{} -> error "impossible, execution is resumed automatically for 'DoEval'"
-    EvalAbortedWith e -> do
+    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 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
+        { evaluateResponseResult             = T.pack resultVal
+        , evaluateResponseType               = T.pack resultType
+        , evaluateResponsePresentationHint   = Nothing
+        , evaluateResponseVariablesReference = fromEnum resultStructureRef
+        , evaluateResponseNamedVariables     = Nothing
+        , evaluateResponseIndexedVariables   = Nothing
+        , evaluateResponseMemoryReference    = Nothing
         }
 
 --------------------------------------------------------------------------------

hdb/Development/Debug/Adapter/Stopped.hs

@@ -43,7 +43,7 @@
 -- | Command to fetch stack trace at current stop point
 commandStackTrace :: DebugAdaptor ()
 commandStackTrace = do
   StackTraceArguments{..} <- getArguments
   GotStacktrace fs <- sendSync GetStacktrace
   case fs of
     []  ->
@@ -153,14 +153,3 @@
         }
     }
 
---------------------------------------------------------------------------------
--- * Utilities
---------------------------------------------------------------------------------
-
--- | From 'ScopeVariablesReference' to a 'VariableReference' that can be used in @"variable"@ requests
-scopeToVarRef :: ScopeVariablesReference -> VariableReference
-scopeToVarRef = \case
-  LocalVariablesScope -> LocalVariables
-  ModuleVariablesScope -> ModuleVariables
-  GlobalVariablesScope -> GlobalVariables
-

test/golden/T61/T61.hdb-stdout

@@ -1,4 +1,4 @@
 [1 of 2] Compiling Main             ( <TEMPORARY-DIRECTORY>/x/Main.hs, interpreted )[main]
 (hdb) wrks
-EvalCompleted {resultVal = "()", resultType = "()"}
+EvalCompleted {resultVal = "()", resultType = "()", resultStructureRef = NoVariables}
 (hdb) Exiting...

test/golden/T79/T79.hdb-stdout

@@ -9,5 +9,5 @@
 
 [1 of 2] Compiling Main             ( <TEMPORARY-DIRECTORY>-tmp]
 (hdb) Hello, Haskell!
-EvalCompleted {resultVal = "()", resultType = "()"}
+EvalCompleted {resultVal = "()", resultType = "()", resultStructureRef = NoVariables}
 (hdb) 

test/golden/T83/T83.hdb-stdout

@@ -1,4 +1,4 @@
 [1 of 2] Compiling Main             ( <TEMPORARY-DIRECTORY>/Main.hs, interpreted )[main]
 (hdb) Heli
-EvalCompleted {resultVal = "()", resultType = "()"}
+EvalCompleted {resultVal = "()", resultType = "()", resultStructureRef = NoVariables}
 (hdb) Exiting...

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

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\'');
+      })
+    })
 })