Custom Debug Visualisations

.github/workflows/debugger.yaml

@@ -5,6 +5,10 @@ on:
   pull_request: {}
   workflow_call: {}
 
+env:
+  haskellDebuggerViewVersion: 0.1.0.0
+  haskellDebuggerVersion: 0.10.0.0
+
 name: Debugger CI
 jobs:
   build-vscode-extension:
@@ -42,10 +46,14 @@ jobs:
       - name: Package hdb
         run: cabal sdist
 
+      - name: Package haskell-debugger-view
+        run: cabal sdist haskell-debugger-view
+
       - name: Upload haskell-debugger source distribution
         uses: actions/upload-artifact@v4
         with:
           name: Haskell Debugger Source Distribution
+          # This will catch both haskell-debugger and haskell-debugger-view
           path: dist-newstyle/sdist/haskell-debugger*.tar.gz
 
   # Building and testing are done on the distributed sdist: not on the full git repo.
@@ -95,8 +103,10 @@ jobs:
       - name: Build and Run integration tests
         run: |
           echo "Running DAP Integration Testsuite now..."
-          (cd ${{ runner.temp }}/dist && tar xzf *.tar.gz && rm *.tar.gz && cd haskell-debugger-* && cabal build exe:hdb --enable-executable-dynamic --allow-newer=ghc-bignum,containers,time,ghc,base,template-haskell)
-          export DEBUGGER=$(cd ${{ runner.temp }}/dist/haskell-debugger-* && cabal list-bin exe:hdb --enable-executable-dynamic --allow-newer=ghc-bignum,containers,time,ghc,base,template-haskell)
+          (cd ${{ runner.temp }}/dist && for f in *.tar.gz; do tar xzf "$f"; done)
+          (cd ${{ runner.temp }}/dist && cd haskell-debugger-${{env.haskellDebuggerVersion}} && echo 'packages: . ../haskell-debugger-view-${{env.haskellDebuggerViewVersion}}' > cabal.project)
+          (cd ${{ runner.temp }}/dist && cd haskell-debugger-${{env.haskellDebuggerVersion}} && cabal build exe:hdb --enable-executable-dynamic --allow-newer=ghc-bignum,containers,time,ghc,base,template-haskell)
+          export DEBUGGER=$(cd ${{ runner.temp }}/dist/haskell-debugger-${{env.haskellDebuggerVersion}} && cabal list-bin exe:hdb --enable-executable-dynamic --allow-newer=ghc-bignum,containers,time,ghc,base,template-haskell)
           echo "DEBUGGER: $DEBUGGER"
           cd test/integration-tests/
           make clean

.github/workflows/release.yaml

@@ -75,7 +75,7 @@ jobs:
         with:
           pat: ${{ secrets.VS_MARKETPLACE_TOKEN }}
           registryUrl: https://marketplace.visualstudio.com
-          extensionFile: ${{ runner.temp }}/extension/haskell-debugger-extension-0.9.0.vsix
+          extensionFile: ${{ runner.temp }}/extension/haskell-debugger-extension-0.10.0.vsix
 
       # Publish a new hackage release of the haskell-debugger
       - name: Hackage Release

CHANGELOG.md

@@ -1,5 +1,7 @@
 # Revision history for haskell-debugger
 
+## 0.10.0.0 -- Unreleased
+
 ## 0.9.0.0 -- 2025-10-13
 
 ### Main changes

cabal.project

@@ -1,4 +1,4 @@
-packages: .
+packages: . haskell-debugger-view
 
 allow-newer: ghc-bignum,containers,time,ghc,base,template-haskell
 

haskell-debugger-view/CHANGELOG.md

@@ -0,0 +1,5 @@
+# Revision history for haskell-debugger-view
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

haskell-debugger-view/haskell-debugger-view.cabal

@@ -0,0 +1,27 @@
+cabal-version:   3.12
+name:            haskell-debugger-view
+version:         0.1.0.0
+license:         NONE
+author:          Matthew Pickering
+maintainer:      matthewtpickering@gmail.com
+build-type:      Simple
+extra-doc-files: CHANGELOG.md
+
+common warnings
+    ghc-options: -Wall
+
+library
+    import:           warnings
+    -- If you add a module here make sure to also add this module to the list
+    -- of modules that we attempt to load when haskell-debug-view is not
+    -- dependend upon transitively, in GHC.Debugger.Session.Builtin
+    exposed-modules:  GHC.Debugger.View.Class
+                      GHC.Debugger.View.Containers
+                      GHC.Debugger.View.Text
+                      GHC.Debugger.View.ByteString
+    build-depends:    base,
+                      containers >= 0.7 && < 0.9,
+                      text >= 2.1 && < 2.3,
+                      bytestring >= 0.12.1 && < 0.13,
+    hs-source-dirs:   src
+    default-language: GHC2021

haskell-debugger-view/src/GHC/Debugger/View/ByteString.hs

@@ -0,0 +1,11 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+module GHC.Debugger.View.ByteString where
+
+import GHC.Debugger.View.Class
+
+import qualified Data.ByteString    as BS
+
+instance DebugView BS.ByteString where
+  debugValue  t = VarValue (show t) False
+  debugFields _ = VarFields []
+

haskell-debugger-view/src/GHC/Debugger/View/Class.hs

@@ -0,0 +1,133 @@
+{-# LANGUAGE DerivingVia, StandaloneDeriving, ViewPatterns, ImpredicativeTypes #-}
+module GHC.Debugger.View.Class where
+
+-- | The representation of the value for some variable on the debugger
+data VarValue = VarValue
+  { -- | The value to display inline for this variable
+    varValue      :: String
+
+    -- | Can this variable further be expanded (s.t. @'debugFields'@ is not null?)
+  , varExpandable :: Bool
+  }
+  deriving (Show, Read)
+
+-- | The representation for fields of a value which is expandable in the debugger
+newtype VarFields = VarFields
+  { varFields :: [(String, VarFieldValue)]
+  }
+
+-- | A box for subfields of a value.
+--
+-- Used to construct the debug-view list of fields one gets from expanding a datatype.
+-- See, for instance, the @DebugView (a, b)@ instance for an example of how it is used.
+--
+-- The boxed value is returned as is and can be further forced or expanded by
+-- the debugger, using either the existing @'DebugView'@ instance for the
+-- existential @a@ (the instance is found at runtime), or the generic runtime
+-- term inspection mechanisms otherwise.
+data VarFieldValue = forall a. VarFieldValue a
+
+-- | Custom handling of debug terms (e.g. in the variables pane, or when
+-- inspecting a lazy variable)
+class DebugView a where
+
+  -- | Compute the representation of a variable with the given value.
+  --
+  -- INVARIANT: this method should only called on values which are already in
+  -- WHNF, never thunks.
+  --
+  -- That said, this method is responsible for determining how much it is
+  -- forced when displaying it inline as a variable.
+  --
+  -- For instance, for @String@, @a@ will be fully forced to display the entire
+  -- string in one go rather than as a linked list of @'Char'@.
+  debugValue :: a -> VarValue
+
+  -- | Compute the fields to display when expanding a value of type @a@.
+  --
+  -- This method should only be called to get the fields if the corresponding
+  -- @'VarValue'@ has @'varExpandable' = True@.
+  debugFields :: a -> VarFields
+
+--------------------------------------------------------------------------------
+
+-- | Boring types scaffolding.
+--
+-- Meant to be used like:
+--
+-- @
+-- deriving via (BoringTy Int) instance (DebugView Int)
+-- @
+--
+-- to derive a 'DebugView' for a type whose terms should always be fully forced
+-- and displayed whole rather than as parts.
+--
+-- A boring type is one for which we don't care about the structure and would
+-- rather see "whole" when being inspected. Strings and literals are a good
+-- example, because it's more useful to see the string value than it is to see
+-- a linked list of characters where each has to be forced individually.
+newtype BoringTy a = BoringTy a
+
+instance Show a => DebugView (BoringTy a) where
+  debugValue (BoringTy x) = VarValue (show x) False
+  debugFields _           = VarFields []
+
+deriving via BoringTy Int     instance DebugView Int
+deriving via BoringTy Word    instance DebugView Word
+deriving via BoringTy Double  instance DebugView Double
+deriving via BoringTy Float   instance DebugView Float
+deriving via BoringTy Integer instance DebugView Integer
+deriving via BoringTy Char    instance DebugView Char
+deriving via BoringTy String  instance DebugView String
+
+instance DebugView (a, b) where
+  debugValue _ = VarValue "( , )" True
+  debugFields (x, y) = VarFields
+    [ ("fst", VarFieldValue x)
+    , ("snd", VarFieldValue y) ]
+
+-- instance DebugView T.Text where
+--   debugValue  t = VarValue (show (T.unpack t)) False
+--   debugFields _ = VarFields []
+--
+-- instance DebugView BS.ByteString where
+--   debugValue  t = VarValue (show (T.unpack (T.decodeUtf8 t))) False
+--   debugFields _ = VarFields []
+--
+-- instance DebugView (IM.IntMap a) where
+--   debugValue _ = VarValue "IntMap" True
+--   debugFields im = VarFields
+--     [ (show k, VarFieldValue v)
+--     | (k, v) <- IM.toList im
+--     ]
+--
+-- instance Show k => DebugView (M.Map k a) where
+--   debugValue _ = VarValue "Map" True
+--   debugFields m = VarFields
+--     [ (show k, VarFieldValue v)
+--     | (k, v) <- M.toList m
+--     ]
+
+--------------------------------------------------------------------------------
+-- * (Internal) Wrappers required to call `evalStmt` on methods more easily
+--------------------------------------------------------------------------------
+
+-- | Wrapper to make evaluating from debugger easier
+data VarValueIO = VarValueIO
+  { varValueIO :: IO String
+  , varExpandableIO :: Bool
+  }
+
+debugValueIOWrapper :: DebugView a => a -> IO [VarValueIO]
+debugValueIOWrapper x = case debugValue x of
+  VarValue str b ->
+    pure [VarValueIO (pure str) b]
+
+newtype VarFieldsIO = VarFieldsIO
+  { varFieldsIO :: [(IO String, VarFieldValue)]
+  }
+
+debugFieldsIOWrapper :: DebugView a => a -> IO [VarFieldsIO]
+debugFieldsIOWrapper x = case debugFields x of
+  VarFields fls ->
+    pure [VarFieldsIO [ (pure fl_s, b) | (fl_s, b) <- fls]]

haskell-debugger-view/src/GHC/Debugger/View/Containers.hs

@@ -0,0 +1,21 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+module GHC.Debugger.View.Containers where
+
+import GHC.Debugger.View.Class
+
+import qualified Data.IntMap        as IM
+import qualified Data.Map           as M
+
+instance DebugView (IM.IntMap a) where
+  debugValue _ = VarValue "IntMap" True
+  debugFields im = VarFields
+    [ (show k, VarFieldValue v)
+    | (k, v) <- IM.toList im
+    ]
+
+instance Show k => DebugView (M.Map k a) where
+  debugValue _ = VarValue "Map" True
+  debugFields m = VarFields
+    [ (show k, VarFieldValue v)
+    | (k, v) <- M.toList m
+    ]

haskell-debugger-view/src/GHC/Debugger/View/Text.hs

@@ -0,0 +1,11 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+module GHC.Debugger.View.Text where
+
+import GHC.Debugger.View.Class
+
+import qualified Data.Text          as T
+
+instance DebugView T.Text where
+  debugValue  t = VarValue (show (T.unpack t)) False
+  debugFields _ = VarFields []
+

haskell-debugger.cabal

@@ -1,6 +1,6 @@
 cabal-version:      3.12
 name:               haskell-debugger
-version:            0.9.0.0
+version:            0.10.0.0
 synopsis:
     A step-through debugger for GHC Haskell
 
@@ -31,6 +31,13 @@ category:           Development
 build-type:         Simple
 extra-doc-files:    CHANGELOG.md
                     README.md
+
+                    -- Make sure to list all files which we embed with TH, so sdist + build works.
+extra-source-files: haskell-debugger-view/src/GHC/Debugger/View/Class.hs
+                    haskell-debugger-view/src/GHC/Debugger/View/Containers.hs
+                    haskell-debugger-view/src/GHC/Debugger/View/Text.hs
+                    haskell-debugger-view/src/GHC/Debugger/View/ByteString.hs
+
 homepage:           https://github.com/well-typed/haskell-debugger
 bug-reports:        https://github.com/well-typed/haskell-debugger/issues
 
@@ -57,17 +64,22 @@ library
                       GHC.Debugger.Stopped.Variables,
                       GHC.Debugger.Utils,
                       GHC.Debugger.Runtime,
+                      GHC.Debugger.Runtime.Instances,
 
                       GHC.Debugger.Runtime.Term.Key,
                       GHC.Debugger.Runtime.Term.Cache,
 
                       GHC.Debugger.Monad,
+
                       GHC.Debugger.Session,
+                      GHC.Debugger.Session.Builtin,
                       GHC.Debugger.Interface.Messages
     -- other-modules:
     default-extensions: CPP
     build-depends:    base > 4.21 && < 5,
                       ghc >= 9.14 && < 9.16, ghci >= 9.14 && < 9.16,
+                      ghc-boot-th >= 9.14 && < 9.16,
+                      ghc-boot >= 9.14 && < 9.16,
                       array >= 0.5.8 && < 0.6,
                       containers >= 0.7 && < 0.9,
                       mtl >= 2.3 && < 3,
@@ -82,12 +94,15 @@ library
                       base16-bytestring >= 1.0.2.0 && < 1.1,
                       aeson >= 2.2.3 && < 2.3,
                       hie-bios >= 0.15 && < 0.18,
+                      file-embed >= 0.0.16 && < 0.1,
                       -- Logger dependencies
                       time >= 1.14 && < 2,
                       prettyprinter >= 1.7.1 && < 2,
                       text >= 2.1 && < 2.3,
                       co-log-core >= 0.3.2.5 && < 0.4,
 
+                      haskell-debugger-view >= 0.1 && < 1.0
+
     hs-source-dirs:   haskell-debugger
     default-language: GHC2021
 

haskell-debugger/GHC/Debugger.hs

@@ -10,7 +10,6 @@ import GHC.Debugger.Breakpoint
 import GHC.Debugger.Evaluation
 import GHC.Debugger.Stopped
 import GHC.Debugger.Monad
-import GHC.Debugger.Utils
 import GHC.Debugger.Interface.Messages
 import GHC.Debugger.Logger
 
@@ -26,17 +25,7 @@ execute recorder = \case
   SetBreakpoint{brk, hitCount, condition} ->
     DidSetBreakpoint <$> setBreakpoint brk (condBreakEnableStatus hitCount condition)
   DelBreakpoint bp -> DidRemoveBreakpoint <$> setBreakpoint bp BreakpointDisabled
-  GetBreakpointsAt ModuleBreak{path, lineNum, columnNum} -> do
-    mmodl <- getModuleByPath path
-    case mmodl of
-      Left e -> do
-        displayWarnings [e]
-        return $ DidGetBreakpoints Nothing
-      Right modl -> do
-        mbfnd <- getBreakpointsAt modl lineNum columnNum
-        return $
-          DidGetBreakpoints (realSrcSpanToSourceSpan . snd <$> mbfnd)
-  GetBreakpointsAt _ -> error "unexpected getbreakpoints without ModuleBreak"
+  GetBreakpointsAt bp -> DidGetBreakpoints <$> getBreakpointsAt bp
   GetStacktrace -> GotStacktrace <$> getStacktrace
   GetScopes -> GotScopes <$> getScopes
   GetVariables kind -> GotVariables <$> getVariables kind
@@ -56,3 +45,4 @@ data DebuggerLog
 instance Pretty DebuggerLog where
   pretty = \ case
     EvalLog msg -> pretty msg
+