Incomplete state of Debug instance visualization

Author: meipp

haskell-debugger/GHC/Debugger/Runtime.hs

@@ -14,6 +14,20 @@ import GHC.Debugger.Runtime.Term.Key
 import GHC.Debugger.Runtime.Term.Cache
 import GHC.Debugger.Monad
 
+import GHC.Core.TyCon
+import GHC.Core.Type
+import GHC.Types.Name
+import GHC.Core.Class
+import GHC.Core.InstEnv
+import Debug.Trace
+import qualified GHC.Linker.Loader as Loader
+import GHC.Driver.Env
+import GHC.Types.Var
+import GHC.Driver.Config
+import GHCi.Message
+import GHC.Runtime.Interpreter
+import GHC.Utils.Outputable
+
 -- | Obtain the runtime 'Term' from a 'TermKey'.
 --
 -- The 'TermKey' will be looked up in the 'TermCache' to avoid recomputing the
@@ -73,4 +87,30 @@ isBoringTy :: Type -> Bool
 isBoringTy t = isDoubleTy t || isFloatTy t || isIntTy t || isWordTy t || isStringTy t
                 || isIntegerTy t || isNaturalTy t || isCharTy t
 
+onDebugInstance :: Term -> Type -> Debugger Bool
+onDebugInstance term t = do
+  hsc_env <- getSession
+  instances <- getInstancesForType t
+
+  case filter ((== "Debug") . occNameString . occName . tyConName . classTyCon . is_cls) instances of
+    (c:_) -> do
+      let methods = (classOpItems . is_cls) c
+      traceM ("Found Debug instance with methods: " ++ (show . map (occNameString . occName . fst)) methods ++ "")
+      case filter ((== "debugDisplayTree") . occNameString . occName . fst) methods of
+        (m:_) -> do
+          let dfun = is_dfun c
+          traceM $ "Dictionary function: " ++ showSDocUnsafe (ppr dfun) ++ " :: " ++ showSDocUnsafe (ppr (varType dfun))
+
+          let method_id = fst m :: Id
+          traceM $ "debugDisplayTree method: " ++ showSDocUnsafe (ppr method_id) ++ " :: "  ++ showSDocUnsafe (ppr (varType method_id))
+
+          (method_hv, _, _) <- liftIO $ Loader.loadName (hscInterp hsc_env) hsc_env (GHC.Types.Var.varName method_id)
+          (dfun_hv, _, _) <- liftIO $ Loader.loadName (hscInterp hsc_env) hsc_env (GHC.Types.Var.varName dfun)
+
+          -- this call fails
+          ev <- liftIO $ evalStmt (hscInterp hsc_env) (initEvalOpts (hsc_dflags hsc_env) EvalStepNone) (EvalApp (EvalApp (EvalThis method_hv) (EvalThis dfun_hv)) (EvalThis (val term)))
 
+          return True
+        [] -> return False
+      return False
+    _  -> return False

haskell-debugger/GHC/Debugger/Stopped/Variables.hs

@@ -116,7 +116,9 @@ termToVarInfo key term0 = do
   -- Pass type as value for functions since actual value is useless
   varValue <- if isFn
     then pure $ "<fn> :: " ++ varType
-    else display =<< GHCD.showTerm (termHead term)
+    else do
+      _ <- onDebugInstance term ty
+      display =<< GHCD.showTerm (termHead term)
   -- liftIO $ print (varName, varType, varValue, GHCI.isFullyEvaluatedTerm term)
 
   -- The VarReference allows user to expand variable structure and inspect its value.