diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# GHC Debugger +# Haskell Debugger Status: **Work In Progress** @@ -12,47 +12,40 @@ # Installation +Please find up to date installation instructions on the +[project homepage](https://well-typed.github.io/haskell-debugger/)! + > [!WARNING] -> `hdb` is only supported by the latest nightly GHC version. +> `hdb` can currently be compiled with the 9.14 alpha pre-releases or with a nightly version > The first release it will be compatible with is GHC 9.14. -To install and use the GHC debugger, you need the executable `hdb` -and the VSCode extension `haskell-debugger-extension`. +To install and use the debugger, you need the executable `hdb` +and the VSCode extension [Haskell Debugger](https://marketplace.visualstudio.com/items?itemName=Well-Typed.haskell-debugger-extension). Since `hdb` implements the [Debug Adapter Protocol (DAP)](https://microsoft.github.io/debug-adapter-protocol/), it also supports debugging with tools such as vim, neovim, or emacs -- as long as a DAP client is installed and the `launch` arguments for `hdb` configured. -To build, install, and run `hdb` you currently need a nightly -version of GHC in PATH. You can get one using -[GHCup](https://ghcup.readthedocs.io/en/latest/guide/), or [building from source](https://gitlab.haskell.org/ghc/ghc/-/wikis/building/preparation): +To run the debugger, the same version of GHC which compiled it needs to be in +PATH. Make sure the DAP client knows this. For instance, to launch VSCode with a specific GHC use: ``` -ghcup config add-release-channel https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-0.0.7.yaml -ghcup install ghc latest-nightly -PATH=$(dirname $(ghcup whereis ghc latest-nightly)):$PATH cabal install haskell-debugger:hdb --enable-executable-dynamic --allow-newer=ghc-bignum,containers,time,ghc +PATH=/path/to/ghc-dir:$PATH code /path/to/proj ``` -To run the debugger, the same nightly version of GHC needs to be in PATH. Make -sure the DAP client knows this. For instance, to launch VSCode use: -``` -PATH=$(dirname $(ghcup whereis ghc latest-nightly)):$PATH code /path/to/proj -``` -Currently, to install the debugger extension, download the `.vsix` file from the -GitHub release artifacts and drag and drop it to the extensions side panel. In -the future we will release it on the marketplace. - # Usage To use the debugger in VSCode, select the debugger tab, select Haskell Debugger, and create a `launch.json` file by clicking the debugger settings icon (next to -the green run button). +the green run button). Now, it is also supported to just Run a file which +contains a `main` function. The `launch.json` file contains some settings about the debugger session here. Namely: | Setting | Description | | --- | --- | +| `projectRoot` | the full path to the project root. this is typically `${workspaceFolder}`, a value which is interpolated by the editor with the actual path | | `entryFile` | the relative path from the project root to the file with the entry point for execution | | `entryPoint` | the name of the function that is called to start execution | | `entryArgs` | the arguments passed to the `entryPoint`. If the `entryPoint` is `main`, these arguments are passed as environment arguments (as in `getArgs`) rather than direct function arguments. | @@ -63,8 +56,6 @@ To run the debugger, simply hit the green run button. See the Features section below for what is currently supported. -Note: Listing global variables is only supported in GHC versions newer than May 6, 2025 - # Related Work `hdb` is inspired by the original @@ -136,7 +127,6 @@ ``` cd test/integration-tests -nix-shell make GHC=/path/to/recent/ghc \ DEBUGGER=$(cd ../.. && cabal list-bin -w /path/to/recent/ghc exe:hdb) ``` diff --git a/haskell-debugger.cabal b/haskell-debugger.cabal --- a/haskell-debugger.cabal +++ b/haskell-debugger.cabal @@ -1,10 +1,10 @@ cabal-version: 3.12 name: haskell-debugger -version: 0.7.0.0 +version: 0.8.0.0 synopsis: A step-through machine-interface debugger for GHC Haskell -description: The GHC debugger package provides a standalone executable +description: This package provides a standalone executable called @hdb@ which can be used to step-through Haskell programs and can act as a Debug Adapter Protocol (DAP) server in the @server@ mode for debugging Haskell @@ -104,7 +104,9 @@ Development.Debug.Adapter.Exit, Development.Debug.Adapter.Handles, Development.Debug.Adapter, - Development.Debug.Interactive + Development.Debug.Interactive, + Paths_haskell_debugger + autogen-modules: Paths_haskell_debugger build-depends: base, ghc, exceptions, aeson, bytestring, diff --git a/haskell-debugger/GHC/Debugger/Interface/Messages.hs b/haskell-debugger/GHC/Debugger/Interface/Messages.hs --- a/haskell-debugger/GHC/Debugger/Interface/Messages.hs +++ b/haskell-debugger/GHC/Debugger/Interface/Messages.hs @@ -20,7 +20,7 @@ -- Commands -------------------------------------------------------------------------------- --- | The commands sent to ghc debugger +-- | The commands sent to the debugger data Command -- | Set a breakpoint on a given function, or module by line number diff --git a/haskell-debugger/GHC/Debugger/Stopped/Variables.hs b/haskell-debugger/GHC/Debugger/Stopped/Variables.hs --- a/haskell-debugger/GHC/Debugger/Stopped/Variables.hs +++ b/haskell-debugger/GHC/Debugger/Stopped/Variables.hs @@ -8,8 +8,11 @@ import GHC import GHC.Types.FieldLabel +import GHC.Types.Id.Info +import GHC.Types.Var import GHC.Runtime.Eval import GHC.Core.DataCon +import GHC.Core.TyCo.Rep import qualified GHC.Runtime.Debugger as GHCD import qualified GHC.Runtime.Heap.Inspect as GHCI @@ -23,10 +26,17 @@ -- | 'TyThing' to 'VarInfo'. The 'Bool' argument indicates whether to force the -- value of the thing (as in @True = :force@, @False = :print@) tyThingToVarInfo :: TyThing -> Debugger VarInfo -tyThingToVarInfo = \case - t@(AConLike c) -> VarInfo <$> display c <*> display t <*> display t <*> pure False <*> pure NoVariables - t@(ATyCon c) -> VarInfo <$> display c <*> display t <*> display t <*> pure False <*> pure NoVariables - t@(ACoAxiom c) -> VarInfo <$> display c <*> display t <*> display t <*> pure False <*> pure NoVariables +tyThingToVarInfo t = case t of + AConLike c -> VarInfo <$> display c <*> display t <*> display t <*> pure False <*> pure NoVariables + ATyCon c -> VarInfo <$> display c <*> display t <*> display t <*> pure False <*> pure NoVariables + ACoAxiom c -> VarInfo <$> display c <*> display t <*> display t <*> pure False <*> pure NoVariables + AnId i + | DataConWrapId data_con <- idDetails i + -- Newtype cons don't have a runtime representation, so we can't obtain + -- terms! Simply print the newtype cons like we do data cons. + -- See Note [Newtype workers] + , isNewTyCon (dataConTyCon data_con) + -> VarInfo <$> display data_con <*> display t <*> display t <*> pure False <*> pure NoVariables AnId i -> do let key = FromId i term <- obtainTerm key @@ -73,11 +83,21 @@ termToVarInfo key term0 = do -- Make a VarInfo for a term let - isThunk - | Suspension{} <- term0 = True - | otherwise = False ty = GHCI.termType term0 + -- Check for function types explicitly since they seem to always match Suspension + -- but should not be shown as thunks in the UI. + checkFn (FunTy _ _ _ _) = True + checkFn (ForAllTy _ t) = checkFn t + checkFn _ = False + isFn = checkFn ty + + isThunk = if not isFn then + case term0 of + Suspension{} -> True + _ -> False + else False + term <- if not isThunk && isBoringTy ty then forceTerm key term0 -- make sure that if it's an evaluated boring term then it is /fully/ evaluated. else pure term0 @@ -90,11 +110,13 @@ | isBoringTy ty = t | otherwise = case t of Term{} -> t{subTerms = []} - NewtypeWrap{wrapped_term} -> t{wrapped_term = termHead wrapped_term} _ -> t varName <- display key varType <- display ty - varValue <- display =<< GHCD.showTerm (termHead term) + -- Pass type as value for functions since actual value is useless + varValue <- if isFn + then pure $ " :: " ++ varType + else 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. diff --git a/hdb/Development/Debug/Adapter/Exit.hs b/hdb/Development/Debug/Adapter/Exit.hs --- a/hdb/Development/Debug/Adapter/Exit.hs +++ b/hdb/Development/Debug/Adapter/Exit.hs @@ -10,8 +10,8 @@ -- * One of the threads launched by registerNewDebugSession crash -- -- == 2. The haskell-debugger process --- * GHC debugger crashes while initializing (e.g. while compiling or when discovering flags) --- * GHC debugger crashes while executing a request +-- * The debugger crashes while initializing (e.g. while compiling or when discovering flags) +-- * The debugger crashes while executing a request -- -- == 3. The debuggee loaded in haskell-debugger and runs -- * The debuggee terminates successfully @@ -71,7 +71,7 @@ -- killing the output thread with @destroyDebugSession@) -> String -- ^ Error message, logged with notification - -> DebugAdaptor () + -> DebugAdaptor a exitCleanupWithMsg final_handle msg = do destroyDebugSession -- kill all session threads (including the output thread) do -- flush buffer and get all pending output from GHC diff --git a/hdb/Development/Debug/Adapter/Init.hs b/hdb/Development/Debug/Adapter/Init.hs --- a/hdb/Development/Debug/Adapter/Init.hs +++ b/hdb/Development/Debug/Adapter/Init.hs @@ -4,6 +4,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} -- | TODO: This module should be called Launch. module Development.Debug.Adapter.Init where @@ -11,8 +12,11 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import qualified System.Process as P +import Control.Monad.Except +import Control.Monad.Trans import Data.Function import Data.Functor +import Data.Maybe import Data.Version (Version(..), showVersion, makeVersion) import Control.Monad.IO.Class import System.IO @@ -62,16 +66,16 @@ = LaunchArgs { __sessionId :: Maybe String -- ^ SessionID, set by VSCode client - , projectRoot :: FilePath + , projectRoot :: Maybe FilePath -- ^ Absolute path to the project root - , entryFile :: FilePath + , entryFile :: Maybe FilePath -- ^ The file with the entry point e.g. @app/Main.hs@ - , entryPoint :: String + , entryPoint :: Maybe String -- ^ Either @main@ or a function name - , entryArgs :: [String] + , entryArgs :: Maybe [String] -- ^ The arguments to either set as environment arguments when @entryPoint = "main"@ -- or function arguments otherwise. - , extraGhcArgs :: [String] + , extraGhcArgs :: Maybe [String] -- ^ Additional arguments to pass to the GHC invocation inferred by hie-bios for this project } deriving stock (Show, Eq, Generic) deriving anyclass FromJSON @@ -80,39 +84,53 @@ -- * Launch Debugger -------------------------------------------------------------------------------- +-- | Exception type for when initialization fails +newtype InitFailed = InitFailed String deriving Show + -- | Initialize debugger -- --- Returns @True@ if successful. -initDebugger :: Recorder (WithSeverity InitLog) -> LaunchArgs -> DebugAdaptor Bool -initDebugger l LaunchArgs{__sessionId, projectRoot, entryFile = entryFile, entryPoint, entryArgs, extraGhcArgs} = do +-- Returns @()@ if successful, throws @InitFailed@ otherwise +initDebugger :: Recorder (WithSeverity InitLog) -> LaunchArgs -> ExceptT InitFailed DebugAdaptor () +initDebugger l LaunchArgs{ __sessionId + , projectRoot = givenRoot + , entryFile = entryFileMaybe + , entryPoint = fromMaybe "main" -> entryPoint + , entryArgs = fromMaybe [] -> entryArgs + , extraGhcArgs = fromMaybe [] -> extraGhcArgs + } = do syncRequests <- liftIO newEmptyMVar syncResponses <- liftIO newEmptyMVar + + entryFile <- case entryFileMaybe of + Nothing -> throwError $ InitFailed "Missing \"entryFile\" key in debugger configuration" + Just ef -> pure ef + + projectRoot <- maybe (liftIO getCurrentDirectory) pure givenRoot + let hieBiosLogger = cmapWithSev FlagsLog l cradle <- liftIO (hieBiosCradle hieBiosLogger projectRoot entryFile) >>= \ case - Left e -> - exitWithMsg e - + Left e -> throwError $ InitFailed e Right c -> pure c - Output.console $ T.pack "Checking GHC version against debugger version..." + lift $ Output.console $ T.pack "Checking GHC version against debugger version..." -- GHC is found in PATH (by hie-bios as well). actualVersion <- liftIO (hieBiosRuntimeGhcVersion hieBiosLogger cradle) >>= \ case - Left e -> - exitWithMsg e + Left e -> throwError $ InitFailed e Right c -> pure c -- Compare the GLASGOW_HASKELL version (e.g. 913) with the actualVersion (e.g. 9.13.1): when (compileTimeGhcWithoutPatchVersion /= forgetPatchVersion actualVersion) $ do - exitWithMsg $ "Aborting...! The GHC version must be the same which " ++ - "ghc-debug-adapter was compiled against (" ++ - showVersion compileTimeGhcWithoutPatchVersion++ - "). Instead, got " ++ (showVersion actualVersion) ++ "." + throwError $ InitFailed $ + "Aborting...! The GHC version must be the same which " ++ + "ghc-debug-adapter was compiled against (" ++ + showVersion compileTimeGhcWithoutPatchVersion++ + "). Instead, got " ++ (showVersion actualVersion) ++ "." - Output.console $ T.pack "Discovering session flags with hie-bios..." + lift $ Output.console $ T.pack "Discovering session flags with hie-bios..." mflags <- liftIO (hieBiosFlags hieBiosLogger cradle projectRoot entryFile) case mflags of - Left e -> exitWithMsg e + Left e -> throwError $ InitFailed e Right flags -> do let nextFreshBreakpointId = 0 @@ -138,7 +156,7 @@ finished_init <- liftIO $ newEmptyMVar let absEntryFile = normalise $ projectRoot entryFile - registerNewDebugSession (maybe "debug-session" T.pack __sessionId) DAS{entryFile=absEntryFile,..} + lift $ registerNewDebugSession (maybe "debug-session" T.pack __sessionId) DAS{entryFile=absEntryFile,..} [ debuggerThread l finished_init writeDebuggerOutput projectRoot flags extraGhcArgs absEntryFile defaultRunConf syncRequests syncResponses , handleDebuggerOutput readDebuggerOutput , stdoutCaptureThread @@ -147,14 +165,13 @@ -- Do not return until the initialization is finished liftIO (takeMVar finished_init) >>= \case - Right () -> return True + Right () -> pure () Left e -> do -- The process terminates cleanly with an error code (probably exit failure = 1) -- This can happen if compilation fails and the compiler exits cleanly. -- -- Instead of signalInitialized, respond with error and exit. - exitCleanupWithMsg readDebuggerOutput e - return False + throwError $ InitFailed e -- | This thread captures stdout from the debugger and sends it to the client. -- NOTE, redirecting the stdout handle is a process-global operation. So this thread @@ -245,7 +262,7 @@ hPutStrLn stderr m putMVar replies (Aborted m) --- | Reads from the read end of the handle to which the GHC debugger writes compiler messages. +-- | Reads from the read end of the handle to which the debugger writes compiler messages. -- Writes the compiler messages to the client console handleDebuggerOutput :: Handle -> (DebugAdaptorCont () -> IO ()) diff --git a/hdb/Main.hs b/hdb/Main.hs --- a/hdb/Main.hs +++ b/hdb/Main.hs @@ -3,7 +3,10 @@ import System.Environment import Data.Maybe +import Data.Version import Text.Read +import Control.Monad.Except +import Control.Monad.IO.Class import DAP @@ -27,6 +30,8 @@ import Options.Applicative hiding (command) import qualified Options.Applicative +import qualified Paths_haskell_debugger as P + -- | The options `hdb` is invoked in the command line with data HdbOptions -- | @server --port @ @@ -90,9 +95,13 @@ ) <|> cliParser -- Default to CLI mode if no subcommand +-- | Parser for --version flag +versioner :: Parser (a -> a) +versioner = simpleVersioner $ "Haskell Debugger, version " ++ showVersion P.version + -- | Main parser info hdbParserInfo :: ParserInfo HdbOptions -hdbParserInfo = info (hdbOptionsParser <**> helper) +hdbParserInfo = info (hdbOptionsParser <**> versioner <**> helper) ( fullDesc <> header "Haskell debugger supporting both CLI and DAP modes" ) @@ -202,14 +211,19 @@ sendInitializeResponse -------------------------------------------------------------------------------- CommandLaunch -> do - success <- initDebugger (cmapWithSev InitLog l) =<< getArguments - if success then do - sendLaunchResponse -- ack - sendInitializedEvent -- our debugger is only ready to be configured after it has launched the session - else - sendError ErrorMessageCancelled Nothing + launch_args <- getArguments + merror <- runExceptT $ initDebugger (cmapWithSev InitLog l) launch_args + case merror of + Right () -> do + sendLaunchResponse -- ack + sendInitializedEvent -- our debugger is only ready to be configured after it has launched the session + Left (InitFailed err) -> do + sendErrorResponse (ErrorMessage (T.pack err)) Nothing + exitCleanly -------------------------------------------------------------------------------- - CommandAttach -> undefined + CommandAttach -> do + sendErrorResponse (ErrorMessage (T.pack "hdb does not support \"attach\" mode yet")) Nothing + exitCleanly -------------------------------------------------------------------------------- CommandBreakpointLocations -> commandBreakpointLocations CommandSetBreakpoints -> commandSetBreakpoints