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

Author: alt-romes

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

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.

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

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

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...