From 54dcc05d49aa9119fe2a485e2ea64647273deca1 Mon Sep 17 00:00:00 2001 From: Rodrigo Mesquita Date: Fri, 26 Sep 2025 15:36:11 +0100 Subject: [PATCH 01/11] Refactor options parsing to separate modules --- haskell-debugger.cabal | 6 + haskell-debugger/GHC/Debugger/Evaluation.hs | 1 - hdb/Development/Debug/Options.hs | 24 ++++ hdb/Development/Debug/Options/Parser.hs | 106 ++++++++++++++++++ hdb/Main.hs | 117 +------------------- 5 files changed, 140 insertions(+), 114 deletions(-) create mode 100644 hdb/Development/Debug/Options.hs create mode 100644 hdb/Development/Debug/Options/Parser.hs diff --git a/haskell-debugger.cabal b/haskell-debugger.cabal index fa3faed..a34c77b 100644 --- a/haskell-debugger.cabal +++ b/haskell-debugger.cabal @@ -103,8 +103,14 @@ executable hdb Development.Debug.Adapter.Exit, Development.Debug.Adapter.Handles, Development.Debug.Adapter, + Development.Debug.Interactive, + Development.Debug.Session.Setup, + + Development.Debug.Options, + Development.Debug.Options.Parser, + Paths_haskell_debugger autogen-modules: Paths_haskell_debugger build-depends: diff --git a/haskell-debugger/GHC/Debugger/Evaluation.hs b/haskell-debugger/GHC/Debugger/Evaluation.hs index 9cee045..b2b98fc 100644 --- a/haskell-debugger/GHC/Debugger/Evaluation.hs +++ b/haskell-debugger/GHC/Debugger/Evaluation.hs @@ -11,7 +11,6 @@ {-# LANGUAGE ViewPatterns #-} module GHC.Debugger.Evaluation where -import GHC.Utils.Trace import GHC.Utils.Outputable import Control.Monad.IO.Class import Control.Monad.Catch diff --git a/hdb/Development/Debug/Options.hs b/hdb/Development/Debug/Options.hs new file mode 100644 index 0000000..5079b47 --- /dev/null +++ b/hdb/Development/Debug/Options.hs @@ -0,0 +1,24 @@ +-- | Options supported by the debugger +-- +-- For parsing see 'Development.Debug.Options.Parser' +module Development.Debug.Options + ( HdbOptions(..) ) where + +import GHC.Debugger.Logger + +-- | The options `hdb` is invoked in the command line with +data HdbOptions + -- | @server --port @ + = HdbDAPServer + { port :: Int + , verbosity :: Verbosity + } + -- | @[--entry-point=] [--extra-ghc-args=""] [] -- []@ + | HdbCLI + { entryPoint :: String + , entryFile :: FilePath + , entryArgs :: [String] + , extraGhcArgs :: [String] + , verbosity :: Verbosity + } + diff --git a/hdb/Development/Debug/Options/Parser.hs b/hdb/Development/Debug/Options/Parser.hs new file mode 100644 index 0000000..9c5c193 --- /dev/null +++ b/hdb/Development/Debug/Options/Parser.hs @@ -0,0 +1,106 @@ +-- | Options parser using optparse-applicative for the debugger options in +-- 'Development.Debug.Options' +module Development.Debug.Options.Parser + ( + -- * Command line options parsing + parseHdbOptions + ) where + +import Options.Applicative hiding (command) + +import Data.Version +import qualified Options.Applicative +import qualified Paths_haskell_debugger as P + +import GHC.Debugger.Logger +import Development.Debug.Options + +-------------------------------------------------------------------------------- +-- Options parser +-------------------------------------------------------------------------------- + +-- | Parser for HdbDAPServer options +serverParser :: Parser HdbOptions +serverParser = HdbDAPServer + <$> option auto + ( long "port" + <> short 'p' + <> metavar "PORT" + <> help "DAP server port" ) + <*> verbosityParser (Verbosity Debug) + +-- | Parser for HdbCLI options +cliParser :: Parser HdbOptions +cliParser = HdbCLI + <$> strOption + ( long "entry-point" + <> short 'e' + <> metavar "ENTRY_POINT" + <> value "main" + <> help "The name of the function that is called to start execution (default: main)" ) + <*> argument str + ( metavar "ENTRY_FILE" + <> help "The relative path from the project root to the file with the entry point for execution" ) + <*> many + ( argument str + ( metavar "ENTRY_ARGS..." + <> help "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." + ) + ) + <*> option (words <$> str) + ( long "extra-ghc-args" + <> metavar "GHC_ARGS" + <> value [] + <> help "Additional flags to pass to the ghc invocation that loads the program for debugging" ) + <*> verbosityParser (Verbosity Warning) + + +-- | Combined parser for HdbOptions +hdbOptionsParser :: Parser HdbOptions +hdbOptionsParser = hsubparser + ( Options.Applicative.command "server" + ( info serverParser + ( progDesc "Start the Haskell debugger in DAP server mode" ) ) + <> Options.Applicative.command "cli" + ( info cliParser + ( progDesc "Debug a Haskell program in CLI mode" ) ) + ) + <|> cliParser -- Default to CLI mode if no subcommand + +-- | Parser for --version flag +versioner :: Parser (a -> a) +versioner = simpleVersioner $ "Haskell Debugger, version " ++ showVersion P.version + +-- | Parser for --verbosity 0 +-- +-- The default verbosity differs by mode (#86): +-- - DAP server mode: DEBUG +-- - CLI mode: WARNING +verbosityParser :: Verbosity -> Parser Verbosity +verbosityParser vdef = option verb + ( long "verbosity" + <> short 'v' + <> metavar "VERBOSITY" + <> value vdef + <> help "Logger verbosity in [0..3] interval, where 0 is silent and 3 is debug" + ) + where + verb = Verbosity <$> (verbNum =<< auto) + verbNum n = case n :: Int of + 0 -> pure Error + 1 -> pure Warning + 2 -> pure Info + 3 -> pure Debug + _ -> readerAbort (ErrorMsg "Verbosity must be a value in [0..3]") + +-- | Main parser info +hdbParserInfo :: ParserInfo HdbOptions +hdbParserInfo = info (hdbOptionsParser <**> versioner <**> helper) + ( fullDesc + <> header "Haskell debugger supporting both CLI and DAP modes" ) + +-- | Parse command line arguments +parseHdbOptions :: IO HdbOptions +parseHdbOptions = customExecParser + defaultPrefs{prefShowHelpOnError = True, prefShowHelpOnEmpty = True} + hdbParserInfo diff --git a/hdb/Main.hs b/hdb/Main.hs index 33e38fa..6b2cc95 100644 --- a/hdb/Main.hs +++ b/hdb/Main.hs @@ -3,7 +3,6 @@ module Main where import System.Environment import Data.Maybe -import Data.Version import Text.Read import Control.Monad.Except @@ -17,125 +16,17 @@ import Development.Debug.Adapter.Evaluation import Development.Debug.Adapter.Exit import Development.Debug.Adapter.Handles import GHC.Debugger.Logger -import Development.Debug.Adapter - -import Development.Debug.Interactive import System.IO (hSetBuffering, BufferMode(LineBuffering)) import qualified DAP.Log as DAP import qualified Data.Text as T import qualified Data.Text.IO as T import GHC.IO.Handle.FD -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 @ - = HdbDAPServer - { port :: Int - , verbosity :: Verbosity - } - -- | @[--entry-point=] [--extra-ghc-args=""] [] -- []@ - | HdbCLI - { entryPoint :: String - , entryFile :: FilePath - , entryArgs :: [String] - , extraGhcArgs :: [String] - , verbosity :: Verbosity - } - --------------------------------------------------------------------------------- --- Options parser --------------------------------------------------------------------------------- - --- | Parser for HdbDAPServer options -serverParser :: Parser HdbOptions -serverParser = HdbDAPServer - <$> option auto - ( long "port" - <> short 'p' - <> metavar "PORT" - <> help "DAP server port" ) - <*> verbosityParser (Verbosity Debug) --- | Parser for HdbCLI options -cliParser :: Parser HdbOptions -cliParser = HdbCLI - <$> strOption - ( long "entry-point" - <> short 'e' - <> metavar "ENTRY_POINT" - <> value "main" - <> help "The name of the function that is called to start execution (default: main)" ) - <*> argument str - ( metavar "ENTRY_FILE" - <> help "The relative path from the project root to the file with the entry point for execution" ) - <*> many - ( argument str - ( metavar "ENTRY_ARGS..." - <> help "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." - ) - ) - <*> option (words <$> str) - ( long "extra-ghc-args" - <> metavar "GHC_ARGS" - <> value [] - <> help "Additional flags to pass to the ghc invocation that loads the program for debugging" ) - <*> verbosityParser (Verbosity Warning) - - --- | Combined parser for HdbOptions -hdbOptionsParser :: Parser HdbOptions -hdbOptionsParser = hsubparser - ( Options.Applicative.command "server" - ( info serverParser - ( progDesc "Start the Haskell debugger in DAP server mode" ) ) - <> Options.Applicative.command "cli" - ( info cliParser - ( progDesc "Debug a Haskell program in CLI mode" ) ) - ) - <|> cliParser -- Default to CLI mode if no subcommand - --- | Parser for --version flag -versioner :: Parser (a -> a) -versioner = simpleVersioner $ "Haskell Debugger, version " ++ showVersion P.version - --- | Parser for --verbosity 0 --- --- The default verbosity differs by mode (#86): --- - DAP server mode: DEBUG --- - CLI mode: WARNING -verbosityParser :: Verbosity -> Parser Verbosity -verbosityParser vdef = option verb - ( long "verbosity" - <> short 'v' - <> metavar "VERBOSITY" - <> value vdef - <> help "Logger verbosity in [0..3] interval, where 0 is silent and 3 is debug" - ) - where - verb = Verbosity <$> (verbNum =<< auto) - verbNum n = case n :: Int of - 0 -> pure Error - 1 -> pure Warning - 2 -> pure Info - 3 -> pure Debug - _ -> readerAbort (ErrorMsg "Verbosity must be a value in [0..3]") - --- | Main parser info -hdbParserInfo :: ParserInfo HdbOptions -hdbParserInfo = info (hdbOptionsParser <**> versioner <**> helper) - ( fullDesc - <> header "Haskell debugger supporting both CLI and DAP modes" ) - --- | Parse command line arguments -parseHdbOptions :: IO HdbOptions -parseHdbOptions = customExecParser - defaultPrefs{prefShowHelpOnError = True, prefShowHelpOnEmpty = True} - hdbParserInfo +import Development.Debug.Options (HdbOptions(..)) +import Development.Debug.Options.Parser (parseHdbOptions) +import Development.Debug.Adapter +import Development.Debug.Interactive -------------------------------------------------------------------------------- From f77a2908b3278f322bd64944b364b7e020882b63 Mon Sep 17 00:00:00 2001 From: Rodrigo Mesquita Date: Mon, 29 Sep 2025 12:46:55 +0100 Subject: [PATCH 02/11] Run hdb proxy with runInTerminal This commit makes the hdb server send a reverse-request to the client and ask it to run @hdb proxy --port ...@ in a Terminal connected to the client. From this Terminal, the user can send input to the debuggee and read its output without additional debugger messages. It is just as if the program was running in that terminal, but it is just a shim program which forwards input/output to the debugger that is running the debuggee Fixes #44 --- haskell-debugger.cabal | 5 + hdb/Development/Debug/Adapter.hs | 8 ++ hdb/Development/Debug/Adapter/Init.hs | 61 ++++++++-- hdb/Development/Debug/Adapter/Proxy.hs | 151 ++++++++++++++++++++++++ hdb/Development/Debug/Options.hs | 20 +++- hdb/Development/Debug/Options/Parser.hs | 19 ++- hdb/Main.hs | 58 +++++++-- 7 files changed, 296 insertions(+), 26 deletions(-) create mode 100644 hdb/Development/Debug/Adapter/Proxy.hs diff --git a/haskell-debugger.cabal b/haskell-debugger.cabal index a34c77b..7e554d1 100644 --- a/haskell-debugger.cabal +++ b/haskell-debugger.cabal @@ -104,6 +104,8 @@ executable hdb Development.Debug.Adapter.Handles, Development.Debug.Adapter, + Development.Debug.Adapter.Proxy, + Development.Debug.Interactive, Development.Debug.Session.Setup, @@ -118,6 +120,7 @@ executable hdb exceptions, aeson, bytestring, containers, filepath, process, mtl, unix, + unordered-containers >= 0.2.19 && < 0.3, haskell-debugger, hie-bios, @@ -128,6 +131,8 @@ executable hdb prettyprinter, directory >= 1.3.9 && < 1.4, + network >= 3.2.8, + network-run >= 0.4.4, async >= 2.2.5 && < 2.3, text >= 2.1 && < 2.3, dap >= 0.2 && < 1, diff --git a/hdb/Development/Debug/Adapter.hs b/hdb/Development/Debug/Adapter.hs index aeca9eb..dc95a44 100644 --- a/hdb/Development/Debug/Adapter.hs +++ b/hdb/Development/Debug/Adapter.hs @@ -1,7 +1,9 @@ module Development.Debug.Adapter where import Control.Concurrent.MVar +import Control.Concurrent.Chan import qualified Data.IntSet as IS +import qualified Data.ByteString as BS import qualified Data.Map as Map import qualified Data.Text as T import System.FilePath @@ -29,6 +31,12 @@ data DebugAdaptorState = DAS , entryPoint :: String , entryArgs :: [String] , projectRoot :: FilePath + , syncProxyIn :: Chan BS.ByteString + -- ^ Read input to the debuggee from the proxy + , syncProxyOut :: Chan BS.ByteString + -- ^ Write output from the debuggee to the proxy + , syncProxyErr :: Chan BS.ByteString + -- ^ Write stderr from the debuggee to the proxy } type BreakpointId = Int diff --git a/hdb/Development/Debug/Adapter/Init.hs b/hdb/Development/Debug/Adapter/Init.hs index 3d5e7fe..61d0b9a 100644 --- a/hdb/Development/Debug/Adapter/Init.hs +++ b/hdb/Development/Debug/Adapter/Init.hs @@ -9,8 +9,12 @@ -- | TODO: This module should be called Launch. module Development.Debug.Adapter.Init where +import GHC.IO.Handle +import System.Process +import qualified Data.ByteString as BS import qualified Data.Text as T import qualified Data.Text.IO as T +import qualified Data.Text.Encoding as T import qualified System.Process as P import Control.Monad.Except import Control.Monad.Trans @@ -88,8 +92,9 @@ newtype InitFailed = InitFailed String deriving Show -- | Initialize debugger -- -- Returns @()@ if successful, throws @InitFailed@ otherwise -initDebugger :: Recorder (WithSeverity InitLog) -> LaunchArgs -> ExceptT InitFailed DebugAdaptor () -initDebugger l LaunchArgs{ __sessionId +initDebugger :: Recorder (WithSeverity InitLog) -> Bool -> LaunchArgs -> ExceptT InitFailed DebugAdaptor () +initDebugger l supportsRunInTerminal + LaunchArgs{ __sessionId , projectRoot = givenRoot , entryFile = entryFileMaybe , entryPoint = fromMaybe "main" -> entryPoint @@ -98,6 +103,9 @@ initDebugger l LaunchArgs{ __sessionId } = do syncRequests <- liftIO newEmptyMVar syncResponses <- liftIO newEmptyMVar + syncProxyIn <- liftIO newChan + syncProxyOut <- liftIO newChan + syncProxyErr <- liftIO newChan entryFile <- case entryFileMaybe of Nothing -> throwError $ InitFailed "Missing \"entryFile\" key in debugger configuration" @@ -134,10 +142,12 @@ initDebugger l LaunchArgs{ __sessionId let absEntryFile = normalise $ projectRoot entryFile lift $ registerNewDebugSession (maybe "debug-session" T.pack __sessionId) DAS{entryFile=absEntryFile,..} - [ debuggerThread l finished_init writeDebuggerOutput projectRoot flags extraGhcArgs absEntryFile defaultRunConf syncRequests syncResponses + [ debuggerThread l finished_init writeDebuggerOutput projectRoot flags + extraGhcArgs absEntryFile defaultRunConf syncRequests syncResponses , handleDebuggerOutput readDebuggerOutput - , stdoutCaptureThread - , stderrCaptureThread + , stdinForwardThread supportsRunInTerminal syncProxyIn + , stdoutCaptureThread supportsRunInTerminal syncProxyOut + , stderrCaptureThread supportsRunInTerminal syncProxyErr ] -- Do not return until the initialization is finished @@ -150,24 +160,49 @@ initDebugger l LaunchArgs{ __sessionId -- Instead of signalInitialized, respond with error and exit. lift $ exitCleanupWithMsg readDebuggerOutput e --- | This thread captures stdout from the debugger and sends it to the client. +-- | This thread captures stdout from the debuggee and sends it to the client. -- NOTE, redirecting the stdout handle is a process-global operation. So this thread --- will capture ANY stdout the debugger emits. Therefore you should never directly +-- will capture ANY stdout the debuggee emits. Therefore you should never directly -- write to stdout, but always write to the appropiate handle. -stdoutCaptureThread :: (DebugAdaptorCont () -> IO ()) -> IO () -stdoutCaptureThread withAdaptor = do +stdoutCaptureThread :: Bool -> Chan BS.ByteString -> (DebugAdaptorCont () -> IO ()) -> IO () +stdoutCaptureThread runInTerminal syncOut withAdaptor = do withInterceptedStdout $ \_ interceptedStdout -> do forever $ do line <- liftIO $ T.hGetLine interceptedStdout - withAdaptor $ Output.stdout line + if runInTerminal then + writeChan syncOut $ T.encodeUtf8 (line <> T.pack "\n") + else + -- Else, output to Debug Console + withAdaptor $ Output.stdout line -- | Like 'stdoutCaptureThread' but for stderr -stderrCaptureThread :: (DebugAdaptorCont () -> IO ()) -> IO () -stderrCaptureThread withAdaptor = do +stderrCaptureThread :: Bool -> Chan BS.ByteString -> (DebugAdaptorCont () -> IO ()) -> IO () +stderrCaptureThread runInTerminal syncErr withAdaptor = do withInterceptedStderr $ \_ interceptedStderr -> do forever $ do line <- liftIO $ T.hGetLine interceptedStderr - withAdaptor $ Output.stderr line + if runInTerminal then + writeChan syncErr $ T.encodeUtf8 (line <> "\n") + else + -- Else, output to Debug Console + withAdaptor $ Output.stderr line + +stdinForwardThread :: Bool -> Chan BS.ByteString -> (DebugAdaptorCont () -> IO ()) -> IO () +stdinForwardThread runInTerminal syncIn _withAdaptor = do + when runInTerminal $ do + -- We need to hijack stdin to write to it + + -- 1. Create a new pipe from writeEnd->readEnd + (readEnd, writeEnd) <- createPipe + + -- 2. Substitute the read-end of the pipe by stdin + _ <- hDuplicateTo readEnd stdin + hClose readEnd -- we'll never need to read from readEnd + + forever $ do + i <- readChan syncIn + -- 3. Write to write-end of the pipe + BS.hPut writeEnd i >> hFlush writeEnd -- | The main debugger thread launches a GHC.Debugger session. -- diff --git a/hdb/Development/Debug/Adapter/Proxy.hs b/hdb/Development/Debug/Adapter/Proxy.hs new file mode 100644 index 0000000..9537a2e --- /dev/null +++ b/hdb/Development/Debug/Adapter/Proxy.hs @@ -0,0 +1,151 @@ +{-# LANGUAGE OverloadedStrings, DerivingStrategies #-} +-- | Run the proxy mode, which forwards stdin/stdout to/from the DAP server and +-- is displayed in a terminal in the DAP client using 'runInTerminal' +module Development.Debug.Adapter.Proxy + ( serverSideHdbProxy + , runInTerminalHdbProxy + , ProxyLog(..) + ) where + +import DAP + +import System.IO +import System.Environment +import System.FilePath +import Control.Exception.Base +import Control.Monad +import Control.Monad.IO.Class +import Control.Concurrent +import qualified Data.List.NonEmpty as NE + +import qualified Data.Text as T +import Network.Socket hiding (Debug) +import Network.Run.TCP +import qualified Network.Socket.ByteString as NBS +import qualified Data.ByteString.Char8 as BS8 +import qualified Data.HashMap.Strict as H + +import GHC.Debugger.Logger +import Development.Debug.Adapter + +newtype ProxyLog = ProxyLog T.Text + deriving newtype Pretty + +-- | Connect to a running @hdb proxy@ process on the given port +-- connectToHdbProxy :: Recorder (WithVerbosity x) -> Int -> DebugAdaptor () +-- connectToHdbProxy = _ + +-- | Fork a new thread to run the server-side of the proxy. +-- +-- 1. To setup: +-- Ask the DAP client to launch a process running @hdb proxy --port @ +-- by sending a 'runInTerminal' DAP reverse request. This is done outside of +-- this function by signaling the given MVar (this is the case because we cannot use `network` with `DebugAdaptor` +-- +-- 2. In a loop, +-- 2.1 Read stdin from the socket and push it to a Chan +-- 2.1 Read from a stdout Chan and write to the socket +serverSideHdbProxy :: Recorder (WithSeverity ProxyLog) + -> DebugAdaptor () +serverSideHdbProxy l = do + DAS { syncProxyIn = dbIn + , syncProxyOut = dbOut + , syncProxyErr = dbErr } <- getDebugSession + + sock <- liftIO $ do + let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV], addrSocketType = Stream } + addr <- NE.head <$> getAddrInfo (Just hints) (Just "127.0.0.1") (Just "0") + -- Bind on "0" to let the OS pick a free port + openTCPServerSocket addr + + port <- liftIO $ socketPort sock + + _ <- liftIO $ forkIO $ ignoreIOException $ do + runTCPServerWithSocket sock $ \scket -> do + + logWith l Info $ ProxyLog $ T.pack $ "Connected to client on port " ++ show port ++ "...!" + + -- -- Read stdout from chan and write to socket + _ <- forkIO $ ignoreIOException $ do + forever $ do + bs <- readChan dbOut + logWith l Debug $ ProxyLog $ T.pack $ "Writing to socket: " ++ BS8.unpack bs + NBS.sendAll scket bs + + -- Read stderr from chan and write to socket + _ <- forkIO $ ignoreIOException $ do + forever $ do + bs <- readChan dbErr + logWith l Debug $ ProxyLog $ T.pack $ "Writing to socket (from stderr): " ++ BS8.unpack bs + NBS.sendAll scket bs + + -- Read stdin from socket and write to chan + let loop = do + bs <- NBS.recv scket 4096 + logWith l Debug $ ProxyLog $ T.pack $ "Read from socket: " ++ BS8.unpack bs + if BS8.null bs + then do + logWith l Debug $ ProxyLog $ T.pack "Connection closed." + else writeChan dbIn bs >> loop + in ignoreIOException loop + + sendRunProxyInTerminal port + + where + ignoreIOException a = catch a $ \(e::IOException) -> + logWith l Info $ ProxyLog $ T.pack $ "Ignoring connection broken to proxy client: " ++ show e + +-- | The proxy code running on the terminal in which the @hdb proxy@ process is launched. +-- +-- This client-side proxy is responsible for +-- 1. Connecting to the given proxy-server port +-- 2. Forwarding stdin to the port it is connected to +-- 3. Read from the network the output and write it to stdout +runInTerminalHdbProxy :: Recorder (WithSeverity ProxyLog) -> Int -> IO () +runInTerminalHdbProxy l port = do + logWith l Info $ ProxyLog $ T.pack $ "Running in terminal on port " ++ show port ++ "...!" + hSetBuffering stdin LineBuffering + + dbg_inv <- lookupEnv "DEBUGGEE_INVOCATION" + case dbg_inv of + Nothing -> pure () + Just inv -> + putStrLn $ "Running the debugger input/output proxy for the following debuggee execution:\n\n\n " ++ inv ++ "\n\n" + + catch ( + runTCPClient "127.0.0.1" (show port) $ \sock -> do + -- Forward stdin to sock + _ <- forkIO $ + catch (forever $ do + str <- BS8.hGetLine stdin + NBS.sendAll sock (str <> BS8.pack "\n") + ) $ \(e::IOException) -> return () -- connection dropped, just exit. + + -- Forward stdout from sock + catch (forever $ do + msg <- NBS.recv sock 4096 + BS8.hPut stdout msg >> hFlush stdout + ) $ \(e::IOException) -> return () -- connection dropped, just exit. + + ) $ \(e::IOException) -> do + hPutStrLn stderr "Failed to connect to debugger server proxy -- did the debuggee compile and started running successfully?" + +-- | Send a 'runInTerminal' reverse request to the DAP client +-- with the @hdb proxy@ invocation +sendRunProxyInTerminal :: PortNumber -> DebugAdaptor () +sendRunProxyInTerminal port = do + DAS { entryFile + , entryPoint + , entryArgs + , projectRoot } <- getDebugSession + let debuggee_inv = T.pack $ makeRelative projectRoot entryFile ++ ":" ++ entryPoint ++ + (if null entryArgs then "" else " ") ++ unwords entryArgs + sendRunInTerminalReverseRequest + RunInTerminalRequestArguments + { runInTerminalRequestArgumentsKind = Just RunInTerminalRequestArgumentsKindIntegrated + , runInTerminalRequestArgumentsTitle = Just debuggee_inv + , runInTerminalRequestArgumentsCwd = "" + , runInTerminalRequestArgumentsArgs = ["hdb", "proxy", "--port", T.pack (show port)] + , runInTerminalRequestArgumentsEnv = Just (H.singleton "DEBUGGEE_INVOCATION" debuggee_inv) + , runInTerminalRequestArgumentsArgsCanBeInterpretedByShell = False + } diff --git a/hdb/Development/Debug/Options.hs b/hdb/Development/Debug/Options.hs index 5079b47..8f81c80 100644 --- a/hdb/Development/Debug/Options.hs +++ b/hdb/Development/Debug/Options.hs @@ -13,7 +13,7 @@ data HdbOptions { port :: Int , verbosity :: Verbosity } - -- | @[--entry-point=] [--extra-ghc-args=""] [] -- []@ + -- | @cli [--entry-point=] [--extra-ghc-args=""] [] -- []@ | HdbCLI { entryPoint :: String , entryFile :: FilePath @@ -22,3 +22,21 @@ data HdbOptions , verbosity :: Verbosity } + -- | @proxy --port @ + -- + -- The proxy command serves as a middle man between the user and the debugger. + -- It is used implicitly by DAP mode: upon initialization, the debugger + -- server asks the DAP client to @runInTerminal@ the @hdb proxy --port ...@ + -- command at a port determined by the debugger server. + -- + -- The proxy mode will forward stdin to the debugger server and will be + -- forwarded the debuggee's stdout. This essentially enables the user to + -- observe and interact with the execution of the debugger, in a standalone + -- terminal. + -- + -- See #44 for the original ticket + | HdbProxy + { port :: Int + , verbosity :: Verbosity + } + diff --git a/hdb/Development/Debug/Options/Parser.hs b/hdb/Development/Debug/Options/Parser.hs index 9c5c193..d7193f8 100644 --- a/hdb/Development/Debug/Options/Parser.hs +++ b/hdb/Development/Debug/Options/Parser.hs @@ -1,8 +1,7 @@ -- | Options parser using optparse-applicative for the debugger options in -- 'Development.Debug.Options' module Development.Debug.Options.Parser - ( - -- * Command line options parsing + ( -- * Command line options parsing parseHdbOptions ) where @@ -19,7 +18,7 @@ import Development.Debug.Options -- Options parser -------------------------------------------------------------------------------- --- | Parser for HdbDAPServer options +-- | Parser for 'HdbDAPServer' options serverParser :: Parser HdbOptions serverParser = HdbDAPServer <$> option auto @@ -29,7 +28,7 @@ serverParser = HdbDAPServer <> help "DAP server port" ) <*> verbosityParser (Verbosity Debug) --- | Parser for HdbCLI options +-- | Parser for 'HdbCLI' options cliParser :: Parser HdbOptions cliParser = HdbCLI <$> strOption @@ -54,6 +53,15 @@ cliParser = HdbCLI <> help "Additional flags to pass to the ghc invocation that loads the program for debugging" ) <*> verbosityParser (Verbosity Warning) +-- | Parser for 'HdbProxy' options +proxyParser :: Parser HdbOptions +proxyParser = HdbProxy + <$> option auto + ( long "port" + <> short 'p' + <> metavar "PORT" + <> help "proxy port to which the debugger connects" ) + <*> verbosityParser (Verbosity Warning) -- | Combined parser for HdbOptions hdbOptionsParser :: Parser HdbOptions @@ -64,6 +72,9 @@ hdbOptionsParser = hsubparser <> Options.Applicative.command "cli" ( info cliParser ( progDesc "Debug a Haskell program in CLI mode" ) ) + <> Options.Applicative.command "proxy" + ( info proxyParser + ( progDesc "Internal mode used by the DAP server to proxy the stdin/stdout to the DAP client's terminal" ) ) ) <|> cliParser -- Default to CLI mode if no subcommand diff --git a/hdb/Main.hs b/hdb/Main.hs index 6b2cc95..3c40862 100644 --- a/hdb/Main.hs +++ b/hdb/Main.hs @@ -3,7 +3,11 @@ module Main where import System.Environment import Data.Maybe +import Data.Aeson +import Data.IORef import Text.Read +import Control.Monad +import Control.Monad.IO.Class import Control.Monad.Except import DAP @@ -16,6 +20,7 @@ import Development.Debug.Adapter.Evaluation import Development.Debug.Adapter.Exit import Development.Debug.Adapter.Handles import GHC.Debugger.Logger +import Prettyprinter import System.IO (hSetBuffering, BufferMode(LineBuffering)) import qualified DAP.Log as DAP @@ -26,6 +31,7 @@ import GHC.IO.Handle.FD import Development.Debug.Options (HdbOptions(..)) import Development.Debug.Options.Parser (parseHdbOptions) import Development.Debug.Adapter +import Development.Debug.Adapter.Proxy import Development.Debug.Interactive -------------------------------------------------------------------------------- @@ -49,14 +55,18 @@ main = do l <- handleLogger realStdout let dapLogger = cmap DAP.renderDAPLog $ timeStampLogger l let runLogger = loggerFinal hdbOpts l - runDAPServerWithLogger (toCologAction dapLogger) config $ - talk runLogger + init_var <- liftIO (newIORef False{-not supported by default-}) + runDAPServerWithLogger (toCologAction dapLogger) config $ \cmd -> do + talk runLogger init_var cmd HdbCLI{..} -> do l <- handleLogger stdout let runLogger = cmapWithSev InteractiveLog $ loggerFinal hdbOpts l runIDM runLogger entryPoint entryFile entryArgs extraGhcArgs $ debugInteractive runLogger - + HdbProxy{port} -> do + l <- handleLogger stdout + let runLogger = cmapWithSev RunProxyClientLog $ loggerFinal hdbOpts l + runInTerminalHdbProxy runLogger port -- | Fetch config from environment, fallback to sane defaults getConfig :: Int -> IO ServerConfig @@ -109,30 +119,53 @@ getConfig port = do data MainLog = InitLog InitLog + | LaunchLog T.Text | InteractiveLog InteractiveLog + | RunProxyServerLog ProxyLog + | RunProxyClientLog ProxyLog instance Pretty MainLog where pretty = \ case InitLog msg -> pretty msg + LaunchLog msg -> pretty msg InteractiveLog msg -> pretty msg + RunProxyServerLog msg -> pretty ("Proxy Server:" :: String) <+> pretty msg + RunProxyClientLog msg -> pretty ("Proxy Client:" :: String) <+> pretty msg -- | Main function where requests are received and Events + Responses are returned. -- The core logic of communicating between the client <-> adaptor <-> debugger -- is implemented in this function. -talk :: Recorder (WithSeverity MainLog) -> Command -> DebugAdaptor () +talk :: Recorder (WithSeverity MainLog) + -> IORef Bool + -> Command -> DebugAdaptor () -------------------------------------------------------------------------------- -talk l = \ case +talk l support_rit_var = \ case CommandInitialize -> do - -- InitializeRequestArguments{..} <- getArguments + InitializeRequestArguments{supportsRunInTerminalRequest} <- getArguments + liftIO $ writeIORef support_rit_var supportsRunInTerminalRequest sendInitializeResponse + -------------------------------------------------------------------------------- CommandLaunch -> do launch_args <- getArguments - merror <- runExceptT $ initDebugger (cmapWithSev InitLog l) launch_args + + supportsRunInTerminalRequest <- liftIO $ readIORef support_rit_var + + merror <- runExceptT $ initDebugger (cmapWithSev InitLog l) supportsRunInTerminalRequest launch_args case merror of Right () -> do sendLaunchResponse -- ack sendInitializedEvent -- our debugger is only ready to be configured after it has launched the session + + -- Run the proxy in a separate terminal to accept stdin / forward stdout + -- if it is supported + when supportsRunInTerminalRequest $ do + -- Run proxy thread, server side, and + -- send the 'runInTerminal' request + serverSideHdbProxy (cmapWithSev RunProxyServerLog l) + + logWith l Info $ LaunchLog $ T.pack "Debugger launched successfully." + Left (InitFailed err) -> do sendErrorResponse (ErrorMessage (T.pack err)) Nothing exitCleanly @@ -169,13 +202,22 @@ talk l = \ case ---------------------------------------------------------------------------- CommandEvaluate -> commandEvaluate ---------------------------------------------------------------------------- - CommandTerminate -> commandTerminate + CommandTerminate -> + -- TODO: ALSO MUST KILL THE PROXY!; STORE PID from runInTerminalResponse (CustomCommand below) + commandTerminate CommandDisconnect -> commandDisconnect ---------------------------------------------------------------------------- CommandModules -> sendModulesResponse (ModulesResponse [] Nothing) CommandSource -> undefined CommandPause -> undefined (CustomCommand "mycustomcommand") -> undefined + (CustomCommand "runInTerminal") -> do + -- Ignore result of runInTerminal (reverse request) response. + -- If it fails, we simply continue without that functionality. + pure () + other -> do + sendErrorResponse (ErrorMessage (T.pack ("Unsupported command: " <> show other))) Nothing + exitCleanly ---------------------------------------------------------------------------- -- talk cmd = logInfo $ BL8.pack ("GOT cmd " <> show cmd) ---------------------------------------------------------------------------- From 0e282926ef2369fe2a0807fb6531c7d8bc10ae02 Mon Sep 17 00:00:00 2001 From: Rodrigo Mesquita Date: Thu, 2 Oct 2025 11:48:34 +0100 Subject: [PATCH 03/11] Kill runInTerminal PID if available Depends on patch to dap which allows runInTerminal response to be received --- hdb/Development/Debug/Adapter/Proxy.hs | 2 +- hdb/Main.hs | 37 ++++++++++++++++++++++---- 2 files changed, 33 insertions(+), 6 deletions(-) diff --git a/hdb/Development/Debug/Adapter/Proxy.hs b/hdb/Development/Debug/Adapter/Proxy.hs index 9537a2e..c4daa8b 100644 --- a/hdb/Development/Debug/Adapter/Proxy.hs +++ b/hdb/Development/Debug/Adapter/Proxy.hs @@ -128,7 +128,7 @@ runInTerminalHdbProxy l port = do ) $ \(e::IOException) -> return () -- connection dropped, just exit. ) $ \(e::IOException) -> do - hPutStrLn stderr "Failed to connect to debugger server proxy -- did the debuggee compile and started running successfully?" + hPutStrLn stderr "Failed to connect to debugger server proxy -- did the debuggee compile and start running successfully?" -- | Send a 'runInTerminal' reverse request to the DAP client -- with the @hdb proxy@ invocation diff --git a/hdb/Main.hs b/hdb/Main.hs index 3c40862..508674e 100644 --- a/hdb/Main.hs +++ b/hdb/Main.hs @@ -2,6 +2,7 @@ module Main where import System.Environment +import System.Process import Data.Maybe import Data.Aeson import Data.IORef @@ -56,8 +57,10 @@ main = do let dapLogger = cmap DAP.renderDAPLog $ timeStampLogger l let runLogger = loggerFinal hdbOpts l init_var <- liftIO (newIORef False{-not supported by default-}) - runDAPServerWithLogger (toCologAction dapLogger) config $ \cmd -> do - talk runLogger init_var cmd + pid_var <- liftIO (newIORef Nothing) + runDAPServerWithLogger (toCologAction dapLogger) config + (talk runLogger init_var pid_var) + (ack runLogger pid_var) HdbCLI{..} -> do l <- handleLogger stdout let runLogger = cmapWithSev InteractiveLog $ loggerFinal hdbOpts l @@ -137,9 +140,12 @@ instance Pretty MainLog where -- is implemented in this function. talk :: Recorder (WithSeverity MainLog) -> IORef Bool + -- ^ Whether the client supports runInTerminal + -> IORef (Maybe Int) + -- ^ The PID of the runInTerminal proxy process -> Command -> DebugAdaptor () -------------------------------------------------------------------------------- -talk l support_rit_var = \ case +talk l support_rit_var pid_var = \ case CommandInitialize -> do InitializeRequestArguments{supportsRunInTerminalRequest} <- getArguments liftIO $ writeIORef support_rit_var supportsRunInTerminalRequest @@ -202,8 +208,12 @@ talk l support_rit_var = \ case ---------------------------------------------------------------------------- CommandEvaluate -> commandEvaluate ---------------------------------------------------------------------------- - CommandTerminate -> - -- TODO: ALSO MUST KILL THE PROXY!; STORE PID from runInTerminalResponse (CustomCommand below) + CommandTerminate -> do + mpid <- liftIO $ readIORef pid_var + case mpid of + Nothing -> pure () + Just pid -> do + callCommand ("kill " ++ show pid) commandTerminate CommandDisconnect -> commandDisconnect ---------------------------------------------------------------------------- @@ -221,3 +231,20 @@ talk l support_rit_var = \ case ---------------------------------------------------------------------------- -- talk cmd = logInfo $ BL8.pack ("GOT cmd " <> show cmd) ---------------------------------------------------------------------------- + +-- | Receive reverse request responses (such as runInTerminal response) +ack :: Recorder (WithSeverity MainLog) + -> IORef (Maybe Int) + -- ^ Reference to PID of runInTerminal proxy process running + -> ReverseRequestResponse -> DebugAdaptorCont () +ack l ref rrr = case rrr.reverseRequestCommand of + ReverseCommandRunInTerminal -> do + when rrr.success $ do + RunInTerminalResponse{..} <- getReverseRequestResponseBody rrr + liftIO $ case runInTerminalResponseProcessId of + Just i -> writeIORef ref (Just i) + Nothing -> case runInTerminalResponseProcessId of + Just i -> writeIORef ref (Just i) + Nothing -> pure () + _ -> pure () + From f08da7b6c2a422aa39b1930ec8f808d2834fdba7 Mon Sep 17 00:00:00 2001 From: Rodrigo Mesquita Date: Thu, 2 Oct 2025 13:50:32 +0100 Subject: [PATCH 04/11] fix: Don't error out when resolveFunctionBreakpoint fails --- haskell-debugger/GHC/Debugger/Breakpoint.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/haskell-debugger/GHC/Debugger/Breakpoint.hs b/haskell-debugger/GHC/Debugger/Breakpoint.hs index 6fbf470..73d50bd 100644 --- a/haskell-debugger/GHC/Debugger/Breakpoint.hs +++ b/haskell-debugger/GHC/Debugger/Breakpoint.hs @@ -84,7 +84,10 @@ setBreakpoint ModuleBreak{path, lineNum, columnNum} bp_status = do setBreakpoint FunctionBreak{function} bp_status = do logger <- getLogger resolveFunctionBreakpoint function >>= \case - Left e -> error (showPprUnsafe e) + Left e -> do + liftIO $ logOutput logger $ text $ + "Failed to resolve function breakpoint " ++ function ++ ".\n" ++ showPprUnsafe e ++ "\nIgnoring..." + return BreakNotFound Right (modl, mod_info, fun_str) -> do let modBreaks = GHC.modInfoModBreaks mod_info applyBreak (bix, spn) = do From a546c1003676d9b7b93199e29401b2e5fc30fb34 Mon Sep 17 00:00:00 2001 From: Rodrigo Mesquita Date: Thu, 2 Oct 2025 14:24:39 +0100 Subject: [PATCH 05/11] proxy: More graceful cleanup which behaves better --- hdb/Development/Debug/Adapter/Proxy.hs | 16 ++++++++++++---- hdb/Main.hs | 12 +----------- 2 files changed, 13 insertions(+), 15 deletions(-) diff --git a/hdb/Development/Debug/Adapter/Proxy.hs b/hdb/Development/Debug/Adapter/Proxy.hs index c4daa8b..f212dba 100644 --- a/hdb/Development/Debug/Adapter/Proxy.hs +++ b/hdb/Development/Debug/Adapter/Proxy.hs @@ -10,6 +10,7 @@ module Development.Debug.Adapter.Proxy import DAP import System.IO +import System.Exit (exitSuccess) import System.Environment import System.FilePath import Control.Exception.Base @@ -82,11 +83,13 @@ serverSideHdbProxy l = do -- Read stdin from socket and write to chan let loop = do bs <- NBS.recv scket 4096 - logWith l Debug $ ProxyLog $ T.pack $ "Read from socket: " ++ BS8.unpack bs if BS8.null bs then do - logWith l Debug $ ProxyLog $ T.pack "Connection closed." - else writeChan dbIn bs >> loop + logWith l Debug $ ProxyLog $ T.pack "Connection to client was closed." + close scket + else do + logWith l Debug $ ProxyLog $ T.pack $ "Read from socket: " ++ BS8.unpack bs + writeChan dbIn bs >> loop in ignoreIOException loop sendRunProxyInTerminal port @@ -124,7 +127,12 @@ runInTerminalHdbProxy l port = do -- Forward stdout from sock catch (forever $ do msg <- NBS.recv sock 4096 - BS8.hPut stdout msg >> hFlush stdout + if BS8.null msg + then do + logWith l Info $ ProxyLog $ T.pack "Exiting..." + close sock + exitSuccess + else BS8.hPut stdout msg >> hFlush stdout ) $ \(e::IOException) -> return () -- connection dropped, just exit. ) $ \(e::IOException) -> do diff --git a/hdb/Main.hs b/hdb/Main.hs index 508674e..7cbacf4 100644 --- a/hdb/Main.hs +++ b/hdb/Main.hs @@ -209,11 +209,6 @@ talk l support_rit_var pid_var = \ case CommandEvaluate -> commandEvaluate ---------------------------------------------------------------------------- CommandTerminate -> do - mpid <- liftIO $ readIORef pid_var - case mpid of - Nothing -> pure () - Just pid -> do - callCommand ("kill " ++ show pid) commandTerminate CommandDisconnect -> commandDisconnect ---------------------------------------------------------------------------- @@ -240,11 +235,6 @@ ack :: Recorder (WithSeverity MainLog) ack l ref rrr = case rrr.reverseRequestCommand of ReverseCommandRunInTerminal -> do when rrr.success $ do - RunInTerminalResponse{..} <- getReverseRequestResponseBody rrr - liftIO $ case runInTerminalResponseProcessId of - Just i -> writeIORef ref (Just i) - Nothing -> case runInTerminalResponseProcessId of - Just i -> writeIORef ref (Just i) - Nothing -> pure () + logWith l Info $ LaunchLog $ T.pack "RunInTerminal was successful" _ -> pure () From 53dd96b7dc1cfb0aeb7791198b0ed1128c80cc7d Mon Sep 17 00:00:00 2001 From: Rodrigo Mesquita Date: Thu, 2 Oct 2025 15:55:45 +0100 Subject: [PATCH 06/11] server: Output stdout to DAP output AND to terminal proxy --- hdb/Development/Debug/Adapter/Init.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/hdb/Development/Debug/Adapter/Init.hs b/hdb/Development/Debug/Adapter/Init.hs index 61d0b9a..3deac59 100644 --- a/hdb/Development/Debug/Adapter/Init.hs +++ b/hdb/Development/Debug/Adapter/Init.hs @@ -169,11 +169,11 @@ stdoutCaptureThread runInTerminal syncOut withAdaptor = do withInterceptedStdout $ \_ interceptedStdout -> do forever $ do line <- liftIO $ T.hGetLine interceptedStdout - if runInTerminal then + when runInTerminal $ writeChan syncOut $ T.encodeUtf8 (line <> T.pack "\n") - else - -- Else, output to Debug Console - withAdaptor $ Output.stdout line + + -- Always output to Debug Console + withAdaptor $ Output.stdout line -- | Like 'stdoutCaptureThread' but for stderr stderrCaptureThread :: Bool -> Chan BS.ByteString -> (DebugAdaptorCont () -> IO ()) -> IO () @@ -181,11 +181,11 @@ stderrCaptureThread runInTerminal syncErr withAdaptor = do withInterceptedStderr $ \_ interceptedStderr -> do forever $ do line <- liftIO $ T.hGetLine interceptedStderr - if runInTerminal then + when runInTerminal $ writeChan syncErr $ T.encodeUtf8 (line <> "\n") - else - -- Else, output to Debug Console - withAdaptor $ Output.stderr line + + -- Always output to Debug Console + withAdaptor $ Output.stderr line stdinForwardThread :: Bool -> Chan BS.ByteString -> (DebugAdaptorCont () -> IO ()) -> IO () stdinForwardThread runInTerminal syncIn _withAdaptor = do From a8d172e53543db61299d61a5a65d99235d5528e3 Mon Sep 17 00:00:00 2001 From: Rodrigo Mesquita Date: Fri, 3 Oct 2025 11:47:08 +0100 Subject: [PATCH 07/11] Bump minimum dap version to 0.3 --- haskell-debugger.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haskell-debugger.cabal b/haskell-debugger.cabal index 7e554d1..4be3b62 100644 --- a/haskell-debugger.cabal +++ b/haskell-debugger.cabal @@ -135,7 +135,7 @@ executable hdb network-run >= 0.4.4, async >= 2.2.5 && < 2.3, text >= 2.1 && < 2.3, - dap >= 0.2 && < 1, + dap >= 0.3 && < 1, haskeline >= 0.8 && < 1, optparse-applicative >= 0.18 && < 0.20 From d734bbae5dc9c2e798e53b23bda21d4f3e94cb03 Mon Sep 17 00:00:00 2001 From: Rodrigo Mesquita Date: Fri, 3 Oct 2025 18:52:20 +0100 Subject: [PATCH 08/11] Writing comprehensive test for #44 --- haskell-debugger.cabal | 9 +- haskell-debugger/GHC/Debugger/Evaluation.hs | 5 +- test/haskell/Main.hs | 30 +-- test/haskell/Test/DAP.hs | 122 +++++++++ test/haskell/Test/DAP/RunInTerminal.hs | 279 ++++++++++++++++++++ test/haskell/Test/Utils.hs | 25 ++ test/unit/T44/Main.hs | 8 + 7 files changed, 455 insertions(+), 23 deletions(-) create mode 100644 test/haskell/Test/DAP.hs create mode 100644 test/haskell/Test/DAP/RunInTerminal.hs create mode 100644 test/haskell/Test/Utils.hs create mode 100644 test/unit/T44/Main.hs diff --git a/haskell-debugger.cabal b/haskell-debugger.cabal index 4be3b62..8806806 100644 --- a/haskell-debugger.cabal +++ b/haskell-debugger.cabal @@ -147,11 +147,11 @@ executable hdb test-suite haskell-debugger-test import: warnings default-language: Haskell2010 - -- other-modules: -- other-extensions: type: exitcode-stdio-1.0 hs-source-dirs: test/haskell/ main-is: Main.hs + other-modules: Test.DAP.RunInTerminal, Test.DAP, Test.Utils build-depends: base >=4.14, haskell-debugger, @@ -160,8 +160,15 @@ test-suite haskell-debugger-test filepath, process, temporary >= 1.3, + + unordered-containers, + aeson-pretty >= 0.8.10, async >= 2.2.5, + dap, network, aeson, network-run, + random >= 1.3.1, + tasty >= 1.5.3, tasty-golden >= 2.3.5, + tasty-hunit >= 0.10.2, regex >= 1.1 build-tool-depends: haskell-debugger:hdb ghc-options: -threaded diff --git a/haskell-debugger/GHC/Debugger/Evaluation.hs b/haskell-debugger/GHC/Debugger/Evaluation.hs index b2b98fc..af8ab3e 100644 --- a/haskell-debugger/GHC/Debugger/Evaluation.hs +++ b/haskell-debugger/GHC/Debugger/Evaluation.hs @@ -119,8 +119,9 @@ debugExecution recorder entryFile entry args = do findUnitIdOfEntryFile fp = do afp <- normalise <$> liftIO (makeAbsolute fp) modSums <- getAllLoadedModules - case List.find ((Just afp ==) . fmap normalise . GHC.ml_hs_file . GHC.ms_location ) modSums of - Nothing -> error $ "findUnitIdOfEntryFile: no unit id found for: " ++ fp + let normalisedModLoc = fmap normalise . GHC.ml_hs_file . GHC.ms_location + case List.find ((Just afp ==) . normalisedModLoc) modSums of + Nothing -> error $ "findUnitIdOfEntryFile: no unit id found for: " ++ fp ++ "\nCandidates were:\n" ++ unlines (map (show . normalisedModLoc) modSums) Just summary -> pure summary -- | Resume execution of the stopped debuggee program diff --git a/test/haskell/Main.hs b/test/haskell/Main.hs index 18d3e57..1e857ed 100644 --- a/test/haskell/Main.hs +++ b/test/haskell/Main.hs @@ -18,12 +18,21 @@ import Test.Tasty import Test.Tasty.Golden as G import Test.Tasty.Golden.Advanced as G +import Test.DAP.RunInTerminal +import Test.Utils + main :: IO () main = do goldens <- mapM (mkGoldenTest False) =<< findByExtension [".hdb-test"] "test/golden" defaultMain $ testGroup "Tests" - goldens + [ testGroup "Golden tests" goldens + , testGroup "Unit tests" unitTests + ] + +unitTests = + [ runInTerminalTests + ] -- | Receives as an argument the path to the @*.hdb-test@ which contains the -- shell invocation for running @@ -43,25 +52,6 @@ mkGoldenTest keepTmpDirs path = do ExitSuccess -> LBS.hGetContents hout ExitFailure c -> error $ "Test script in " ++ test_dir ++ " failed with exit code: " ++ show c --- | Copy the contents of a test directory (with a `*.hdb-test` in the root) to --- a temporary location and return the path to the new location. -withHermeticDir :: Bool -- ^ Whether to keep the temp dir around for inspection - -> FilePath -- ^ Test dir - -> (FilePath -> IO r) -- ^ Continuation receives hermetic test dir (in temporary dir) - -> IO r -withHermeticDir keep src k = do - withTmpDir "hdb-test" $ \dest -> do - P.callCommand $ "cp -r " ++ src ++ " " ++ dest - k (dest takeBaseName src) - where - withTmpDir | keep = withPersistentSystemTempDirectory - | otherwise = withSystemTempDirectory - - withPersistentSystemTempDirectory :: String -> (FilePath -> IO r) -> IO r - withPersistentSystemTempDirectory template k' = do - dir <- flip createTempDirectory template =<< getCanonicalTemporaryDirectory - k' dir - -------------------------------------------------------------------------------- -- Tasty Golden Advanced wrapper -------------------------------------------------------------------------------- diff --git a/test/haskell/Test/DAP.hs b/test/haskell/Test/DAP.hs new file mode 100644 index 0000000..bb31da4 --- /dev/null +++ b/test/haskell/Test/DAP.hs @@ -0,0 +1,122 @@ +-- | Utils essentially copied from `dap`'s test suite +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE LambdaCase #-} +module Test.DAP where + +---------------------------------------------------------------------------- +import Control.Applicative +import Control.Concurrent +import Data.Aeson.Encode.Pretty +import Data.Aeson.Types +import Data.Aeson.KeyMap +import Control.Exception hiding (handle) +import qualified Data.ByteString.Lazy.Char8 as BL8 ( hPutStrLn ) +import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as B8 ( hPutStrLn ) +import qualified Data.HashMap.Strict as H +import Network.Run.TCP +import Network.Socket (socketToHandle) +import System.IO +import System.Exit +import Data.IORef +---------------------------------------------------------------------------- +import DAP.Utils +import DAP.Server +import DAP.Types (Command) +---------------------------------------------------------------------------- +import Test.Tasty.HUnit + +-- | Sends a DAP request to the given handle +sendDAPRequest :: ToJSON a => Handle -> Command -> a -> IO () +sendDAPRequest handle cmd args = do + send handle + [ "seq" .= (1 :: Int) + , "type" .= ("request" :: String) + , "command" .= cmd + , "arguments".= args + ] + +-- | Receive and decode DAP message +recvDAPResponse + :: FromJSON a + => Handle + -- ^ Handle to receive bytes from + -> IO a + -- ^ The decoded DAP message +recvDAPResponse h = do + readPayload h >>= \case + Left e -> fail e + Right actual -> + -- Read field "body" or "arguments" (for reverse requests) + case parseMaybe (withObject "response/rev request" $ \r -> (do + ("response" :: String) <- r .: "type" + True <- r .: "success" + r .: "body") <|> (do + ("request" :: String) <- r .: "type" + r .: "arguments") + ) actual of + Nothing -> fail $ "Failed to parse DAP response body: " ++ show actual + Just body -> + case parseMaybe parseJSON body of + Nothing -> fail $ "Failed to parse DAP response body content: " ++ show body + Just res -> pure res + +-------------------------------------------------------------------------------- + +-- | Sample host shared amongst client and server +-- +testHost :: String +testHost = "127.0.0.1" + +-- | Spawns a new mock client that connects to the mock server. +-- +withNewClient :: Int -- ^ Port + -> IORef Bool + -- ^ True if we've already connected once and therefore should no longer retry + -> (Handle -> IO ()) + -> IO () +withNewClient port retryVar continue = flip catch exceptionHandler $ + runTCPClient testHost (show port) $ \socket -> do + h <- socketToHandle socket ReadWriteMode + hSetNewlineMode h NewlineMode { inputNL = CRLF, outputNL = CRLF } + continue h `finally` hClose h + where + exceptionHandler :: SomeException -> IO () + exceptionHandler e = do + do_retry <- readIORef retryVar + if do_retry then do + threadDelay 100_000 -- 0.1s + -- Do it silently: + -- putStrLn "Retrying connection..." + withNewClient port retryVar continue + else do + putStrLn $ displayException e + exitWith (ExitFailure 22) + +-- | Helper to send JSON payloads to the server +-- +send :: Handle -> [Pair] -> IO () +send h message + = BS.hPutStr h $ encodeBaseProtocolMessage (object message) + +-- | Helper to receive JSON payloads to the client +-- checks if 'Handle' returns a subset expected payload +-- +shouldReceive + :: Handle + -- ^ Handle to receive bytes from + -> [Pair] + -- ^ Subset of JSON values that should be present in the payload + -> IO () +shouldReceive h expected = do + case object expected of + Object ex -> + readPayload h >>= \case + Left e -> fail e + Right actual + | toHashMapText ex `H.isSubmapOf` toHashMapText actual -> pure () + | otherwise -> encodePretty actual @=? encodePretty ex + _ -> fail "Invalid JSON" diff --git a/test/haskell/Test/DAP/RunInTerminal.hs b/test/haskell/Test/DAP/RunInTerminal.hs new file mode 100644 index 0000000..88ef5ff --- /dev/null +++ b/test/haskell/Test/DAP/RunInTerminal.hs @@ -0,0 +1,279 @@ +-- | 'runInTerminal' tests +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE LambdaCase #-} +module Test.DAP.RunInTerminal (runInTerminalTests) where + +import Control.Concurrent +import DAP.Types +import DAP.Utils +import Data.Aeson +import Data.IORef +import Data.List (isInfixOf) +import System.FilePath +import System.IO +import System.Random +import Test.DAP +import Test.Tasty +import Test.Tasty.HUnit +import Test.Utils +import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Lazy.Char8 as LB8 +import qualified Data.HashMap.Strict as H +import qualified Data.Text as T +import qualified System.Process as P + +runInTerminalTests = + testGroup "DAP.RunInTerminal" + [ testCase "runInTerminal: proxy forwards stdin correctly" runInTerminal1 + ] + +rit_keep_tmp_dirs :: Bool +rit_keep_tmp_dirs = False + +runInTerminal1 = do + withHermeticDir rit_keep_tmp_dirs "test/unit/T44" $ \test_dir -> do + + -- Come up with a random port + testPort <- randomRIO (49152, 65534) :: IO Int + + -- Launch server process + (Just hin, Just hout, _, p) + <- P.createProcess (P.shell $ "hdb server --port " ++ show testPort) + {P.cwd = Just test_dir, P.std_out = P.CreatePipe, P.std_in = P.CreatePipe} + + -- Fork thread to print out output of server process + -- This is surprisingly needed, otherwise the server process + -- will be broken, perhaps because it blocks trying to write to stdout/stderr if the buffer is full? + forkIO $ do + hSetBuffering hout LineBuffering + let loop = do + eof <- hIsEOF hout + if eof + then return () + else do + _l <- hGetLine hout + -- putStrLn ("[server] " ++ l) + loop + loop + + retryVar <- newIORef True + -- Connect to the DAP server + withNewClient testPort retryVar $ \handle -> do + -- As soon as we get a connection, stop retrying + writeIORef retryVar False + + -- Initialize + sendDAPRequest handle CommandInitialize InitializeRequestArguments + { adapterID = "haskell-debugger" + , clientID = Just "mock-client" + , clientName = Just "Mock Client" + , columnsStartAt1 = True + , linesStartAt1 = True + , locale = Just "en" + , pathFormat = Just Path + , supportsArgsCanBeInterpretedByShell = True + , supportsInvalidatedEvent = True + , supportsMemoryEvent = True + , supportsMemoryReferences = True + , supportsProgressReporting = True + , supportsRunInTerminalRequest = True + , supportsStartDebuggingRequest = True + , supportsVariablePaging = True + , supportsVariableType = True + } + + -- Recv initalize response + _ <- shouldReceive handle [] + + -- Send launch request + send handle + [ "command" .= ("launch" :: String) + , "seq" .= (2 :: Int) + , "type" .= ("request" :: String) + , "arguments".= object + [ "entryFile" .= (test_dir "Main.hs" :: String) + , "entryPoint" .= ("main" :: String) + , "projectRoot" .= (test_dir :: String) + , "extraGhcArgs" .= ([] :: [String]) + , "entryArgs" .= ([] :: [String]) + , "request" .= ("launch" :: String) + ] + ] + + _ <- shouldReceive handle + ["type" .= ("event" :: String), "event" .= ("output" :: String)] + _ <- shouldReceive handle + ["type" .= ("event" :: String), "event" .= ("output" :: String)] + _ <- shouldReceive handle + [ "command" .= ("launch" :: String) + , "success" .= True] + _ <- shouldReceive handle + [ "event" .= ("initialized" :: String) + , "type" .= ("event" :: String) + ] + + -- Receive a runInTerminal request!! + r@RunInTerminalRequestArguments{} <- recvDAPResponse handle + (Just rit_in, Just rit_out, _, rit_p) + <- P.createProcess + (P.shell $ T.unpack $ + "/usr/bin/env " <> addRITEnv r.runInTerminalRequestArgumentsEnv <> " " <> T.unwords (r.runInTerminalRequestArgumentsArgs)) + {P.cwd = Just test_dir, P.std_in = P.CreatePipe, P.std_out = P.CreatePipe} + + -- Send a breakpoint request + sendDAPRequest handle CommandSetBreakpoints + SetBreakpointsArguments + { setBreakpointsArgumentsSource = Source + { sourceName = Just "Main.hs" + , sourcePath = Just $ T.pack $ test_dir "Main.hs" + , sourceSourceReference = Nothing + , sourcePresentationHint = Nothing + , sourceOrigin = Nothing + , sourceAdapterData = Nothing + , sourceChecksums = Nothing + , sourceSources = Nothing + } + , setBreakpointsArgumentsBreakpoints = Just [SourceBreakpoint {sourceBreakpointLine = 6, sourceBreakpointColumn = Nothing, sourceBreakpointCondition = Nothing, sourceBreakpointHitCondition = Nothing, sourceBreakpointLogMessage = Nothing}] + , setBreakpointsArgumentsLines = Just [6] + , setBreakpointsArgumentsSourceModified = Just False + } + + _ <- shouldReceive handle + [ "command" .= ("setBreakpoints" :: String) + , "success" .= True + , "type" .= ("response" :: String) + ] + + -- Send runInTerminal response + Just rit_pid <- P.getPid rit_p + send handle + [ "command" .= ("runInTerminal" :: String) + , "seq" .= (6 :: Int) + , "type" .= ("response" :: String) + , "success" .= True + , "body" .= object + [ "shellProcessId" .= (fromIntegral rit_pid :: Int) + ] + ] + + send handle + [ "seq" .= (1 :: Int) + , "type" .= ("request" :: String) + , "command" .= CommandConfigurationDone + ] + + _ <- shouldReceive handle + [ "command" .= ("configurationDone" :: String) + , "success" .= True + , "type" .= ("response" :: String) + ] + + -- The program should start running now, and hit the breakpoint. + -- It will also print "Hello". Since the order is not important, we just + -- match on the type == event and ignore if it's "stopped" or "output" + _ <- shouldReceive handle + [ "type" .= ("event" :: String) ] + _ <- shouldReceive handle + [ "type" .= ("event" :: String) ] + + -- Continue from "getLine" which will block waiting for input + goToNextLine handle + + let secret_in = "SOMETHING_SECRET" + + -- Time to write to the stdin of the rit process + hSetBuffering rit_in LineBuffering + hPutStrLn rit_in secret_in + + -- Only after writing should we receive the next "stopped" event + _ <- shouldReceive handle + ["type" .= ("event" :: String), "event" .= ("stopped" :: String)] + + -- To next line, which should be the "putStrLn" after the "getLine" + goToNextLine handle + -- It's both stopped and we receive the SOMETHING_SECRET printed out. Order not important. + _ <- shouldReceive handle + ["type" .= ("event" :: String)] + _ <- shouldReceive handle + ["type" .= ("event" :: String)] + + -- The contents of the rit_output should contain "hello" plus printing of what we wrote + out <- LBS.hGetContents rit_out + let out_str = LB8.unpack out + assertBool ("Expected output to contain 'hello', got: " ++ out_str) + ("hello" `isInfixOf` out_str) + assertBool ("Expected output to contain '" ++ secret_in ++ "' , got: " ++ out_str) + (secret_in `isInfixOf` out_str) + + -- Send disconnect + sendDAPRequest handle CommandDisconnect (DisconnectArguments {disconnectArgumentsRestart = False, disconnectArgumentsTerminateDebuggee = True, disconnectArgumentsSuspendDebuggee = False}) + _ <- shouldReceive handle + [ "command" .= ("disconnect" :: String) + , "success" .= True + , "type" .= ("response" :: String) + ] + _ <- shouldReceive handle + [ "event" .= ("terminated" :: String) + , "type" .= ("event" :: String) + ] + -- Kill the processes if they're still running + P.terminateProcess rit_p + P.terminateProcess p + + where + goToNextLine handle = do + _ <- sendDAPRequest handle CommandNext (Just (NextArguments {nextArgumentsThreadId = 0, nextArgumentsSingleThread = Nothing, nextArgumentsGranularity = Nothing})) + _ <- shouldReceive handle + [ "command" .= ("next" :: String) + , "success" .= True + , "type" .= ("response" :: String) + ] + return () + + addRITEnv :: Maybe (H.HashMap T.Text T.Text) -> T.Text + addRITEnv env = + case env of + Nothing -> "" + Just env -> T.unwords [k{-todo: escape-} <> "=" <> v | (k,v) <- H.toList env] +-------------------------------------------------------------------------------- +instance ToJSON InitializeRequestArguments where + toJSON InitializeRequestArguments{..} = object + [ "adapterID" .= adapterID + , "clientID" .= clientID + , "clientName" .= clientName + , "columnsStartAt1" .= columnsStartAt1 + , "linesStartAt1" .= linesStartAt1 + , "locale" .= locale + , "pathFormat" .= pathFormat + , "supportsArgsCanBeInterpretedByShell" .= supportsArgsCanBeInterpretedByShell + , "supportsInvalidatedEvent" .= supportsInvalidatedEvent + , "supportsMemoryEvent" .= supportsMemoryEvent + , "supportsMemoryReferences" .= supportsMemoryReferences + , "supportsProgressReporting" .= supportsProgressReporting + , "supportsRunInTerminalRequest" .= supportsRunInTerminalRequest + , "supportsStartDebuggingRequest" .= supportsStartDebuggingRequest + , "supportsVariablePaging" .= supportsVariablePaging + , "supportsVariableType" .= supportsVariableType + ] +instance ToJSON PathFormat where + toJSON Path = String "path" + toJSON URI = String "uri" + toJSON (PathFormat x) = String x +instance ToJSON SetBreakpointsArguments where + toJSON = genericToJSONWithModifier +instance ToJSON NextArguments where + toJSON = genericToJSONWithModifier +instance ToJSON DisconnectArguments where + toJSON = genericToJSONWithModifier +instance ToJSON SourceBreakpoint where + toJSON = genericToJSONWithModifier +instance ToJSON SteppingGranularity where + toJSON = genericToJSONWithModifier +instance FromJSON bps => FromJSON (Breakpoints bps) where + parseJSON = withObject "bkrps" $ \o -> + Breakpoints <$> o .: "breakpoints" +instance FromJSON Breakpoint where + parseJSON = genericParseJSONWithModifier + diff --git a/test/haskell/Test/Utils.hs b/test/haskell/Test/Utils.hs new file mode 100644 index 0000000..988a4f1 --- /dev/null +++ b/test/haskell/Test/Utils.hs @@ -0,0 +1,25 @@ +module Test.Utils where + +import System.FilePath +import System.IO.Temp +import qualified System.Process as P + +-- | Copy the contents of a test directory (with a `*.hdb-test` in the root) to +-- a temporary location and return the path to the new location. +withHermeticDir :: Bool -- ^ Whether to keep the temp dir around for inspection + -> FilePath -- ^ Test dir + -> (FilePath -> IO r) -- ^ Continuation receives hermetic test dir (in temporary dir) + -> IO r +withHermeticDir keep src k = do + withTmpDir "hdb-test" $ \dest -> do + P.callCommand $ "cp -r " ++ src ++ " " ++ dest + k (dest takeBaseName src) + where + withTmpDir | keep = withPersistentSystemTempDirectory + | otherwise = withSystemTempDirectory + + withPersistentSystemTempDirectory :: String -> (FilePath -> IO r) -> IO r + withPersistentSystemTempDirectory template k' = do + dir <- flip createTempDirectory template =<< getCanonicalTemporaryDirectory + k' dir + diff --git a/test/unit/T44/Main.hs b/test/unit/T44/Main.hs new file mode 100644 index 0000000..d5bb8a1 --- /dev/null +++ b/test/unit/T44/Main.hs @@ -0,0 +1,8 @@ +import System.IO + +main :: IO () +main = do + putStrLn "hello" + arg <- getLine + print arg + putStrLn "goodbye" From fc0282f0e5759df874dc868534b086f7ddd791e0 Mon Sep 17 00:00:00 2001 From: Rodrigo Mesquita Date: Mon, 6 Oct 2025 17:24:01 +0100 Subject: [PATCH 09/11] Do nothing on CommandPause This makes it less likely for one to accidentally crash the DAP server by clicking on play twice (the second time falling on top of the pause button) --- hdb/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hdb/Main.hs b/hdb/Main.hs index 7cbacf4..8dad46a 100644 --- a/hdb/Main.hs +++ b/hdb/Main.hs @@ -214,7 +214,7 @@ talk l support_rit_var pid_var = \ case ---------------------------------------------------------------------------- CommandModules -> sendModulesResponse (ModulesResponse [] Nothing) CommandSource -> undefined - CommandPause -> undefined + CommandPause -> pure () -- TODO (CustomCommand "mycustomcommand") -> undefined (CustomCommand "runInTerminal") -> do -- Ignore result of runInTerminal (reverse request) response. From c204704ce31b54a6db45b4a76fe1c1ee45886bff Mon Sep 17 00:00:00 2001 From: Rodrigo Mesquita Date: Tue, 7 Oct 2025 11:53:39 +0100 Subject: [PATCH 10/11] Update InitializeRequestArguments to comply to protocol --- hdb/Main.hs | 2 +- test/haskell/Test/DAP/RunInTerminal.hs | 22 +++++++++++----------- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/hdb/Main.hs b/hdb/Main.hs index 8dad46a..77a8049 100644 --- a/hdb/Main.hs +++ b/hdb/Main.hs @@ -148,7 +148,7 @@ talk :: Recorder (WithSeverity MainLog) talk l support_rit_var pid_var = \ case CommandInitialize -> do InitializeRequestArguments{supportsRunInTerminalRequest} <- getArguments - liftIO $ writeIORef support_rit_var supportsRunInTerminalRequest + liftIO $ writeIORef support_rit_var (fromMaybe False supportsRunInTerminalRequest) sendInitializeResponse -------------------------------------------------------------------------------- diff --git a/test/haskell/Test/DAP/RunInTerminal.hs b/test/haskell/Test/DAP/RunInTerminal.hs index 88ef5ff..804640b 100644 --- a/test/haskell/Test/DAP/RunInTerminal.hs +++ b/test/haskell/Test/DAP/RunInTerminal.hs @@ -69,19 +69,19 @@ runInTerminal1 = do { adapterID = "haskell-debugger" , clientID = Just "mock-client" , clientName = Just "Mock Client" - , columnsStartAt1 = True - , linesStartAt1 = True + , columnsStartAt1 = Just True + , linesStartAt1 = Just True , locale = Just "en" , pathFormat = Just Path - , supportsArgsCanBeInterpretedByShell = True - , supportsInvalidatedEvent = True - , supportsMemoryEvent = True - , supportsMemoryReferences = True - , supportsProgressReporting = True - , supportsRunInTerminalRequest = True - , supportsStartDebuggingRequest = True - , supportsVariablePaging = True - , supportsVariableType = True + , supportsArgsCanBeInterpretedByShell = Nothing + , supportsInvalidatedEvent = Nothing + , supportsMemoryEvent = Nothing + , supportsMemoryReferences = Nothing + , supportsProgressReporting = Nothing + , supportsRunInTerminalRequest = Just True + , supportsStartDebuggingRequest = Nothing + , supportsVariablePaging = Nothing + , supportsVariableType = Nothing } -- Recv initalize response From e290c9abc6cf15daad3e70467b64cb09ae848f75 Mon Sep 17 00:00:00 2001 From: Rodrigo Mesquita Date: Wed, 8 Oct 2025 11:09:27 +0100 Subject: [PATCH 11/11] vscode: Fix extension build and update pkglock --- vscode-extension/default.nix | 4 +- vscode-extension/package-lock.json | 157 ++++++++++++++++------------- 2 files changed, 87 insertions(+), 74 deletions(-) diff --git a/vscode-extension/default.nix b/vscode-extension/default.nix index 99d5f79..513c75c 100644 --- a/vscode-extension/default.nix +++ b/vscode-extension/default.nix @@ -5,10 +5,10 @@ pkgs.buildNpmPackage { version = "0.8.0"; src = ./.; - npmDepsHash = "sha256-Sp5CCtw5kC82gjWL7x7aZ48+geJ/R+LJFMw8RkqsH6c="; + npmDepsHash = "sha256-rvPlvEsFygi/EYh0vcOBDAC4Sf5nzJIfaN8HjdsVXE0="; nativeBuildInputs = [ - pkgs.nodejs pkgs.vsce pkgs.cacert pkgs.nodePackages.rimraf + pkgs.nodejs pkgs.vsce pkgs.cacert pkgs.esbuild pkgs.pkg-config ]; diff --git a/vscode-extension/package-lock.json b/vscode-extension/package-lock.json index 97d0804..f4a5a51 100644 --- a/vscode-extension/package-lock.json +++ b/vscode-extension/package-lock.json @@ -1,12 +1,12 @@ { "name": "haskell-debugger-extension", - "version": "0.1.0.0", + "version": "0.8.0", "lockfileVersion": 3, "requires": true, "packages": { "": { "name": "haskell-debugger-extension", - "version": "0.1.0", + "version": "0.8.0", "license": "MIT", "devDependencies": { "@types/glob": "^7.2.0", @@ -50,9 +50,9 @@ } }, "node_modules/@eslint-community/eslint-utils": { - "version": "4.7.0", - "resolved": "https://registry.npmjs.org/@eslint-community/eslint-utils/-/eslint-utils-4.7.0.tgz", - "integrity": "sha512-dyybb3AcajC7uha6CvhdVRJqaKyn7w2YKqKyAN37NKYgZT36w+iRb0Dymmc5qEJ549c/S31cMMSFd75bteCpCw==", + "version": "4.9.0", + "resolved": "https://registry.npmjs.org/@eslint-community/eslint-utils/-/eslint-utils-4.9.0.tgz", + "integrity": "sha512-ayVFHdtZ+hsq1t2Dy24wCmGXGe4q9Gu3smhLYALJrr473ZH27MsnSL+LKUlimp4BWJqMDMLmPpx/Q9R3OAlL4g==", "dev": true, "license": "MIT", "dependencies": { @@ -228,16 +228,16 @@ "license": "MIT" }, "node_modules/@types/semver": { - "version": "7.7.0", - "resolved": "https://registry.npmjs.org/@types/semver/-/semver-7.7.0.tgz", - "integrity": "sha512-k107IF4+Xr7UHjwDc7Cfd6PRQfbdkiRabXGRjo07b4WyPahFBZCZ1sE+BNxYIJPPg73UkfOsVOLwqVc/6ETrIA==", + "version": "7.7.1", + "resolved": "https://registry.npmjs.org/@types/semver/-/semver-7.7.1.tgz", + "integrity": "sha512-FmgJfu+MOcQ370SD0ev7EI8TlCAfKYU+B4m5T3yXc1CiRN94g/SZPtsCkk506aUDtlMnFZvasDwHHUcZUEaYuA==", "dev": true, "license": "MIT" }, "node_modules/@types/vscode": { - "version": "1.99.1", - "resolved": "https://registry.npmjs.org/@types/vscode/-/vscode-1.99.1.tgz", - "integrity": "sha512-cQlqxHZ040ta6ovZXnXRxs3fJiTmlurkIWOfZVcLSZPcm9J4ikFpXuB7gihofGn5ng+kDVma5EmJIclfk0trPQ==", + "version": "1.104.0", + "resolved": "https://registry.npmjs.org/@types/vscode/-/vscode-1.104.0.tgz", + "integrity": "sha512-0KwoU2rZ2ecsTGFxo4K1+f+AErRsYW0fsp6A0zufzGuhyczc2IoKqYqcwXidKXmy2u8YB2GsYsOtiI9Izx3Tig==", "dev": true, "license": "MIT" }, @@ -452,9 +452,9 @@ "license": "ISC" }, "node_modules/acorn": { - "version": "8.14.1", - "resolved": "https://registry.npmjs.org/acorn/-/acorn-8.14.1.tgz", - "integrity": "sha512-OvQ/2pUDKmgfCg++xsTX1wGxfTaszcHVcTctW4UJB4hibJx2HXxxO5UmVgyjMa+ZDsiaf5wWLXYpRWMmBI0QHg==", + "version": "8.15.0", + "resolved": "https://registry.npmjs.org/acorn/-/acorn-8.15.0.tgz", + "integrity": "sha512-NZyJarBfL7nWwIq+FDL6Zp/yHEhePMNnnJ0y3qfieCrmNvYct8uvtiV41UvlSe6apAfk0fY1FbWx+NwfmpvtTg==", "dev": true, "license": "MIT", "bin": { @@ -637,9 +637,9 @@ "license": "ISC" }, "node_modules/brace-expansion": { - "version": "1.1.11", - "resolved": "https://registry.npmjs.org/brace-expansion/-/brace-expansion-1.1.11.tgz", - "integrity": "sha512-iCuPHDFgrHX7H2vEI/5xpz07zSHB00TpugqhmYtVmMO6518mCuRMoOYFldEBl0g187ufozdaHgWKcYFb61qGiA==", + "version": "1.1.12", + "resolved": "https://registry.npmjs.org/brace-expansion/-/brace-expansion-1.1.12.tgz", + "integrity": "sha512-9T9UjW3r0UW5c1Q7GTwllptXwhvYmEzFhzMfZ9H7FQWt+uZePjZPjBP/W1ZEyZ1twGWom5/56TF4lPcqjnDHcg==", "dev": true, "license": "MIT", "dependencies": { @@ -774,26 +774,26 @@ } }, "node_modules/cheerio": { - "version": "1.0.0", - "resolved": "https://registry.npmjs.org/cheerio/-/cheerio-1.0.0.tgz", - "integrity": "sha512-quS9HgjQpdaXOvsZz82Oz7uxtXiy6UIsIQcpBj7HRw2M63Skasm9qlDocAM7jNuaxdhpPU7c4kJN+gA5MCu4ww==", + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/cheerio/-/cheerio-1.1.2.tgz", + "integrity": "sha512-IkxPpb5rS/d1IiLbHMgfPuS0FgiWTtFIm/Nj+2woXDLTZ7fOT2eqzgYbdMlLweqlHbsZjxEChoVK+7iph7jyQg==", "dev": true, "license": "MIT", "dependencies": { "cheerio-select": "^2.1.0", "dom-serializer": "^2.0.0", "domhandler": "^5.0.3", - "domutils": "^3.1.0", - "encoding-sniffer": "^0.2.0", - "htmlparser2": "^9.1.0", - "parse5": "^7.1.2", - "parse5-htmlparser2-tree-adapter": "^7.0.0", + "domutils": "^3.2.2", + "encoding-sniffer": "^0.2.1", + "htmlparser2": "^10.0.0", + "parse5": "^7.3.0", + "parse5-htmlparser2-tree-adapter": "^7.1.0", "parse5-parser-stream": "^7.1.2", - "undici": "^6.19.5", + "undici": "^7.12.0", "whatwg-mimetype": "^4.0.0" }, "engines": { - "node": ">=18.17" + "node": ">=20.18.1" }, "funding": { "url": "https://github.com/cheeriojs/cheerio?sponsor=1" @@ -930,9 +930,9 @@ } }, "node_modules/css-select": { - "version": "5.1.0", - "resolved": "https://registry.npmjs.org/css-select/-/css-select-5.1.0.tgz", - "integrity": "sha512-nwoRF1rvRRnnCqqY7updORDsuqKzqYJ28+oSMaJMMgOauh3fvwHqMS7EZpIPqK8GL+g9mKxF1vP/ZjSeNjEVHg==", + "version": "5.2.2", + "resolved": "https://registry.npmjs.org/css-select/-/css-select-5.2.2.tgz", + "integrity": "sha512-TizTzUddG/xYLA3NXodFM0fSbNizXjOKhqiQQwvhlspadZokn1KDy0NZFS0wuEubIYAV5/c1/lAr0TaaFXEXzw==", "dev": true, "license": "BSD-2-Clause", "dependencies": { @@ -947,9 +947,9 @@ } }, "node_modules/css-what": { - "version": "6.1.0", - "resolved": "https://registry.npmjs.org/css-what/-/css-what-6.1.0.tgz", - "integrity": "sha512-HTUrgRJ7r4dsZKU6GjmpfRK1O76h97Z8MfS1G0FozR+oF2kG6Vfe8JE6zwrkbxigziPHinCJ+gCPjA9EaBDtRw==", + "version": "6.2.2", + "resolved": "https://registry.npmjs.org/css-what/-/css-what-6.2.2.tgz", + "integrity": "sha512-u/O3vwbptzhMs3L1fQE82ZSLHQQfto5gyZzwteVIEyeaY5Fc7R4dapF/BvRoSYFeqfBk4m0V1Vafq5Pjv25wvA==", "dev": true, "license": "BSD-2-Clause", "engines": { @@ -960,9 +960,9 @@ } }, "node_modules/debug": { - "version": "4.4.0", - "resolved": "https://registry.npmjs.org/debug/-/debug-4.4.0.tgz", - "integrity": "sha512-6WTZ/IxCY/T6BALoZHaE4ctp9xm+Z5kY/pzYaCHRFeyVhojxlrm+46y68HA6hr0TcwEssoxNiDEUJQjfPZ/RYA==", + "version": "4.4.3", + "resolved": "https://registry.npmjs.org/debug/-/debug-4.4.3.tgz", + "integrity": "sha512-RGwwWnwQvkVfavKVt22FGLw+xYSdzARwm0ru6DhTVA3umU5hZc28V3kO4stgYryrTlLpuvgI9GiijltAjNbcqA==", "dev": true, "license": "MIT", "dependencies": { @@ -1024,9 +1024,9 @@ "license": "MIT" }, "node_modules/detect-libc": { - "version": "2.0.4", - "resolved": "https://registry.npmjs.org/detect-libc/-/detect-libc-2.0.4.tgz", - "integrity": "sha512-3UDv+G9CsCKO1WKMGw9fwq/SWJYbI0c5Y7LU1AXYoDdbhE2AHQ6N6Nb34sG8Fj7T5APy8qXDCKuuIHd1BR0tVA==", + "version": "2.1.2", + "resolved": "https://registry.npmjs.org/detect-libc/-/detect-libc-2.1.2.tgz", + "integrity": "sha512-Btj2BOOO83o3WyH59e8MgXsxEQVcarkUOpEYrubB0urwnN10yQ364rsiByU11nZlqWYZm05i/of7io4mzihBtQ==", "dev": true, "license": "Apache-2.0", "engines": { @@ -1151,9 +1151,9 @@ "license": "MIT" }, "node_modules/encoding-sniffer": { - "version": "0.2.0", - "resolved": "https://registry.npmjs.org/encoding-sniffer/-/encoding-sniffer-0.2.0.tgz", - "integrity": "sha512-ju7Wq1kg04I3HtiYIOrUrdfdDvkyO9s5XM8QAj/bN61Yo/Vb4vgJxy5vi4Yxk01gWHbrofpPtpxM8bKger9jhg==", + "version": "0.2.1", + "resolved": "https://registry.npmjs.org/encoding-sniffer/-/encoding-sniffer-0.2.1.tgz", + "integrity": "sha512-5gvq20T6vfpekVtqrYQsSCFZ1wEg5+wW0/QaZMWkFr6BqD3NfKs0rLCx4rrVlSWJeZb5NBJgVLswK/w2MWU+Gw==", "dev": true, "license": "MIT", "dependencies": { @@ -1165,9 +1165,9 @@ } }, "node_modules/end-of-stream": { - "version": "1.4.4", - "resolved": "https://registry.npmjs.org/end-of-stream/-/end-of-stream-1.4.4.tgz", - "integrity": "sha512-+uw1inIHVPQoaVuHzRyXd21icM+cnt4CzD5rW+NC1wjOUSTOs+Te7FOv7AhN7vS9x/oIyhLP5PR1H+phQAHu5Q==", + "version": "1.4.5", + "resolved": "https://registry.npmjs.org/end-of-stream/-/end-of-stream-1.4.5.tgz", + "integrity": "sha512-ooEGc6HP26xXq/N+GCGOT0JKCLDGrq2bQUZrQ7gyrJiZANJ/8YDTxTpQBXGMn+WbIQXNVpyWymm7KYVICQnyOg==", "dev": true, "license": "MIT", "dependencies": { @@ -2238,9 +2238,9 @@ } }, "node_modules/htmlparser2": { - "version": "9.1.0", - "resolved": "https://registry.npmjs.org/htmlparser2/-/htmlparser2-9.1.0.tgz", - "integrity": "sha512-5zfg6mHUoaer/97TxnGpxmbR7zJtPwIYFMZ/H5ucTlPZhKvtum05yiPK3Mgai3a0DyVxv7qYqoweaEd2nrYQzQ==", + "version": "10.0.0", + "resolved": "https://registry.npmjs.org/htmlparser2/-/htmlparser2-10.0.0.tgz", + "integrity": "sha512-TwAZM+zE5Tq3lrEHvOlvwgj1XLWQCtaaibSN11Q+gGBAS7Y1uZSWwXXRe4iF6OXnaq1riyQAPFOBtYc77Mxq0g==", "dev": true, "funding": [ "https://github.com/fb55/htmlparser2?sponsor=1", @@ -2253,8 +2253,21 @@ "dependencies": { "domelementtype": "^2.3.0", "domhandler": "^5.0.3", - "domutils": "^3.1.0", - "entities": "^4.5.0" + "domutils": "^3.2.1", + "entities": "^6.0.0" + } + }, + "node_modules/htmlparser2/node_modules/entities": { + "version": "6.0.1", + "resolved": "https://registry.npmjs.org/entities/-/entities-6.0.1.tgz", + "integrity": "sha512-aN97NXWF6AWBTahfVOIrB/NShkzi5H7F9r1s9mD3cDj4Ko5f2qhhVoYMibXF7GlLveb/D2ioWay8lxI97Ven3g==", + "dev": true, + "license": "BSD-2-Clause", + "engines": { + "node": ">=0.12" + }, + "funding": { + "url": "https://github.com/fb55/entities?sponsor=1" } }, "node_modules/iconv-lite": { @@ -2899,9 +2912,9 @@ "license": "MIT" }, "node_modules/node-abi": { - "version": "3.75.0", - "resolved": "https://registry.npmjs.org/node-abi/-/node-abi-3.75.0.tgz", - "integrity": "sha512-OhYaY5sDsIka7H7AtijtI9jwGYLyl29eQn/W623DiN/MIv5sUqc4g7BIDThX+gb7di9f6xK02nkp8sdfFWZLTg==", + "version": "3.78.0", + "resolved": "https://registry.npmjs.org/node-abi/-/node-abi-3.78.0.tgz", + "integrity": "sha512-E2wEyrgX/CqvicaQYU3Ze1PFGjc4QYPGsjUrlYkqAE0WjHEZwgOsGMPMzkMse4LjJbDmaEuDX3CM036j5K2DSQ==", "dev": true, "license": "MIT", "dependencies": { @@ -3088,9 +3101,9 @@ } }, "node_modules/parse5/node_modules/entities": { - "version": "6.0.0", - "resolved": "https://registry.npmjs.org/entities/-/entities-6.0.0.tgz", - "integrity": "sha512-aKstq2TDOndCn4diEyp9Uq/Flu2i1GlLkc6XIDQSDMuaFE3OPW5OphLCyQ5SpSJZTb4reN+kTcYru5yIfXoRPw==", + "version": "6.0.1", + "resolved": "https://registry.npmjs.org/entities/-/entities-6.0.1.tgz", + "integrity": "sha512-aN97NXWF6AWBTahfVOIrB/NShkzi5H7F9r1s9mD3cDj4Ko5f2qhhVoYMibXF7GlLveb/D2ioWay8lxI97Ven3g==", "dev": true, "license": "BSD-2-Clause", "engines": { @@ -3205,9 +3218,9 @@ } }, "node_modules/pump": { - "version": "3.0.2", - "resolved": "https://registry.npmjs.org/pump/-/pump-3.0.2.tgz", - "integrity": "sha512-tUPXtzlGM8FE3P0ZL6DVs/3P58k9nk8/jZeQCurTJylQA8qFYzHFfhBJkuqyE0FifOsQ0uKWekiZ5g8wtr28cw==", + "version": "3.0.3", + "resolved": "https://registry.npmjs.org/pump/-/pump-3.0.3.tgz", + "integrity": "sha512-todwxLMY7/heScKmntwQG8CXVkWUOdYxIvY2s0VWAAMh/nd8SoYiRaKjlr7+iCs984f2P8zvrfWcDDYVb73NfA==", "dev": true, "license": "MIT", "dependencies": { @@ -3447,9 +3460,9 @@ "license": "ISC" }, "node_modules/semver": { - "version": "7.7.1", - "resolved": "https://registry.npmjs.org/semver/-/semver-7.7.1.tgz", - "integrity": "sha512-hlq8tAfn0m/61p4BVRcPzIGr6LKiMwo4VM6dGi6pt4qcRkmNzTcWq6eCEjEh+qXjkMDvPlOFFSGwQjoEa6gyMA==", + "version": "7.7.3", + "resolved": "https://registry.npmjs.org/semver/-/semver-7.7.3.tgz", + "integrity": "sha512-SdsKMrI9TdgjdweUSR9MweHA4EJ8YxHn8DFaDisvhVlUOe4BF1tLD7GAj0lIqWVl+dPb/rExr0Btby5loQm20Q==", "dev": true, "license": "ISC", "bin": { @@ -3690,9 +3703,9 @@ } }, "node_modules/tar-fs": { - "version": "2.1.2", - "resolved": "https://registry.npmjs.org/tar-fs/-/tar-fs-2.1.2.tgz", - "integrity": "sha512-EsaAXwxmx8UB7FRKqeozqEPop69DXcmYwTQwXvyAPF352HJsPdkVhvTaDPYqfNgruveJIJy3TA2l+2zj8LJIJA==", + "version": "2.1.4", + "resolved": "https://registry.npmjs.org/tar-fs/-/tar-fs-2.1.4.tgz", + "integrity": "sha512-mDAjwmZdh7LTT6pNleZ05Yt65HC3E+NiQzl672vQG38jIrehtJk/J3mNwIg+vShQPcLF/LV7CMnDW6vjj6sfYQ==", "dev": true, "license": "MIT", "dependencies": { @@ -3727,9 +3740,9 @@ "license": "MIT" }, "node_modules/tmp": { - "version": "0.2.3", - "resolved": "https://registry.npmjs.org/tmp/-/tmp-0.2.3.tgz", - "integrity": "sha512-nZD7m9iCPC5g0pYmcaxogYKggSfLsdxl8of3Q/oIbqCqLLIO9IAF0GWjX1z9NZRHPiXv8Wex4yDCaZsgEw0Y8w==", + "version": "0.2.5", + "resolved": "https://registry.npmjs.org/tmp/-/tmp-0.2.5.tgz", + "integrity": "sha512-voyz6MApa1rQGUxT3E+BK7/ROe8itEx7vD8/HEvt4xwXucvQ5G5oeEiHkmHZJuBO21RpOf+YYm9MOivj709jow==", "dev": true, "license": "MIT", "engines": { @@ -3862,13 +3875,13 @@ "license": "MIT" }, "node_modules/undici": { - "version": "6.21.2", - "resolved": "https://registry.npmjs.org/undici/-/undici-6.21.2.tgz", - "integrity": "sha512-uROZWze0R0itiAKVPsYhFov9LxrPMHLMEQFszeI2gCN6bnIIZ8twzBCJcN2LJrBBLfrP0t1FW0g+JmKVl8Vk1g==", + "version": "7.16.0", + "resolved": "https://registry.npmjs.org/undici/-/undici-7.16.0.tgz", + "integrity": "sha512-QEg3HPMll0o3t2ourKwOeUAZ159Kn9mx5pnzHRQO8+Wixmh88YdZRiIwat0iNzNNXn0yoEtXJqFpyW7eM8BV7g==", "dev": true, "license": "MIT", "engines": { - "node": ">=18.17" + "node": ">=20.18.1" } }, "node_modules/uri-js": {