packages feed

haskell-debugger 0.12.1.0 → 0.12.2.0

raw patch · 77 files changed

+729/−216 lines, 77 filesdep +prettyprinterdep ~hie-biosPVP ok

version bump matches the API change (PVP)

Dependencies added: prettyprinter

Dependency ranges changed: hie-bios

API changes (from Hackage documentation)

Files

CHANGELOG.md view
@@ -1,5 +1,14 @@ # Revision history for haskell-debugger +## 0.12.2.0 -- 2026-03-09++* Bug fixes and improved progress reporting+* It's now possible interactively debug GHC itself! This works by simply:+    1. Using GHC 9.14 as the boot compiler+    2. Creating .vscode/launch.json in the GHC tree root with+        * `entryFile: "ghc/Main.hs"`+        * `entryArgs: "["-B${workspaceFolder}/_build/stage0/lib/", "Test.hs"]"`+ ## 0.12.1.0 -- 2026-02-24  * Update range of supported runtime `haskell-debugger-view` versions to `0.2.*`
haskell-debugger.cabal view
@@ -1,6 +1,6 @@ cabal-version:      3.12 name:               haskell-debugger-version:            0.12.1.0+version:            0.12.2.0 synopsis:     A step-through debugger for GHC Haskell @@ -9,17 +9,17 @@                     programs and can act as a Debug Adapter Protocol (DAP)                     server in the @server@ mode for debugging Haskell                     programs.-                    .+                                         The Debug Adapter is implemented on top of the                     @haskell-debugger@ library which defines the primitive                     debugging capabilities. These debugger features are                     implemented by managing a GHC session and debugging it                     through the GHC API.-                    .+                                         The @hdb@ is transparently compatible with most projects                     because it uses @hie-bios@ to figure out the right flags to                     invoke GHC with.-                    .+                                         Additional information can be found [in the README](https://github.com/well-typed/haskell-debugger).  license:            BSD-3-Clause@@ -38,6 +38,13 @@                     haskell-debugger-view/src/GHC/Debugger/View/Text.hs                     haskell-debugger-view/src/GHC/Debugger/View/ByteString.hs +                    -- Should probably be extra extra-files but that requires cabal 3.14+                    test/golden/**/*.hs+                    test/golden/**/*.hdb-stdin+                    test/golden/**/*.hdb-stdout+                    test/golden/**/*.hdb-test+                    test/golden/**/*.debuggee-stdin+ homepage:           https://github.com/well-typed/haskell-debugger bug-reports:        https://github.com/well-typed/haskell-debugger/issues @@ -109,7 +116,7 @@                       cryptohash-sha1 >= 0.11.101.0 && < 0.12,                       base16-bytestring >= 1.0.2.0 && < 1.1,                       aeson >= 2.2.3 && < 2.3,-                      hie-bios >= 0.15 && < 0.18,+                      hie-bios >= 0.15 && < 0.19,                       file-embed >= 0.0.16 && < 0.1,                       attoparsec >= 0.13 && < 0.15,                       time >= 1.14 && < 2,@@ -159,6 +166,7 @@          haskell-debugger,         hie-bios,+        prettyprinter ^>= 1.7.0,         co-log-core >= 0.3.2.5 && < 0.4,         implicit-hie ^>=0.1.4.0,         transformers >= 0.6 && < 0.7,
haskell-debugger/GHC/Debugger/Monad.hs view
@@ -165,7 +165,8 @@       }  -- | Run a 'Debugger' action on a session constructed from a given GHC invocation.-runDebugger :: LogAction IO DebuggerLog+runDebugger :: forall a+             . LogAction IO DebuggerLog             -> FilePath   -- ^ Cradle root directory             -> FilePath   -- ^ Component root directory             -> FilePath   -- ^ The libdir (given with -B as an arg)@@ -268,135 +269,142 @@           }       } -    when (GHC.gopt GHC.Opt_ExternalInterpreter dflags2) $ liftIO $ void $ do-      -- The external interpreter is spawned lazily, so we block waiting for-      -- the handles to be available in a new thread.-      forkIO $ do+    let+      externalInterpFwdThread :: IO ()+      externalInterpFwdThread = when (GHC.gopt GHC.Opt_ExternalInterpreter dflags2) $ do+        -- The external interpreter is spawned lazily, so we block waiting for+        -- the handles to be available in a new thread.         withAsync (takeMVar iserv_handles) $ \async_handles -> do           (serv_out, serv_err) <- wait async_handles           concurrently_             (forwardHandleToLogger serv_err (contramap LogDebuggeeErr l))             (forwardHandleToLogger serv_out (contramap LogDebuggeeOut l)) -    -- Initializes interpreter!-    _ <- GHC.setSessionDynFlags dflags2--    -- Initialise plugins here because the plugin author might already expect this-    -- subsequent call to `getLogger` to be affected by a plugin.-    GHC.initializeSessionPlugins+      mainGhcThread :: Ghc a+      mainGhcThread = do+        -- Initializes interpreter!+        _ <- GHC.setSessionDynFlags dflags2 -    GHC.getSessionDynFlags >>= \df -> liftIO $-      GHC.initUniqSupply (GHC.initialUnique df) (GHC.uniqueIncrement df)+        -- Initialise plugins here because the plugin author might already expect this+        -- subsequent call to `getLogger` to be affected by a plugin.+        GHC.initializeSessionPlugins -    -- Discover the user-given flags and targets-    flagsAndTargets <- parseHomeUnitArguments mainFp compDir units ghcInvocation dflags2 rootDir-    buildWays       <- liftIO $ validateUnitsWays flagsAndTargets+        GHC.getSessionDynFlags >>= \df -> liftIO $+          GHC.initUniqSupply (GHC.initialUnique df) (GHC.uniqueIncrement df) -    -- Setup base HomeUnitGraph-    setupHomeUnitGraph (NonEmpty.toList flagsAndTargets)-    -- Downsweep user-given modules first-    mod_graph_base <- doDownsweep Nothing+        -- Discover the user-given flags and targets+        flagsAndTargets <- parseHomeUnitArguments mainFp compDir units ghcInvocation dflags2 rootDir+        buildWays       <- liftIO $ validateUnitsWays flagsAndTargets -    if_cache <- Just <$> liftIO newIfaceCache+        -- Setup base HomeUnitGraph+        setupHomeUnitGraph (NonEmpty.toList flagsAndTargets)+        -- Downsweep user-given modules first+        mod_graph_base <- doDownsweep Nothing -    -- Try to find or load the built-in classes from `haskell-debugger-view`-    (hdv_uid, loadedBuiltinModNames) <- findHsDebuggerViewUnitId mod_graph_base >>= \case-      Nothing -> (hsDebuggerViewInMemoryUnitId,) <$> do+        if_cache <- Just <$> liftIO newIfaceCache -        -- Not imported by any module: no custom views. Therefore, the builtin-        -- ones haven't been loaded. In this case, we will load the package ourselves.+        -- Try to find or load the built-in classes from `haskell-debugger-view`+        (hdv_uid, loadedBuiltinModNames) <- findHsDebuggerViewUnitId mod_graph_base >>= \case+          Nothing -> (hsDebuggerViewInMemoryUnitId,) <$> do -        -- Add the custom unit to the HUG-        let base_dep_uids = [uid | UnitNode _ uid <- mg_mss mod_graph_base]-        addInMemoryHsDebuggerViewUnit base_dep_uids . setDynFlagWays buildWays =<< getDynFlags+            -- Not imported by any module: no custom views. Therefore, the builtin+            -- ones haven't been loaded. In this case, we will load the package ourselves. -        tryLoadHsDebuggerViewModule l if_cache (const False) debuggerViewClassModName debuggerViewClassContents-          >>= \case-            Failed -> do-              -- Failed to load base debugger-view module!-              ghcLog <& DebuggerLog Logger.Debug-                (LogFailedToCompileDebugViewModule debuggerViewClassModName)-              return []-            Succeeded -> (debuggerViewClassModName:) . concat <$> do+            -- Add the custom unit to the HUG+            let base_dep_uids = [uid | UnitNode _ uid <- mg_mss mod_graph_base]+            addInMemoryHsDebuggerViewUnit base_dep_uids . setDynFlagWays buildWays =<< getDynFlags -              forM debuggerViewInstancesMods $ \(modName, modContent, pkgName) -> do-                -- Don't try to load instances whose packages are not even in-                -- the module graph:-                if any ((pkgName `L.isPrefixOf`) . unitIdString) base_dep_uids then do-                  tryLoadHsDebuggerViewModule l if_cache-                      ((\case-                          -- Keep only "GHC.Debugger.View.Class", which is a dependency of all these.-                          GHC.TargetFile f _-                            -> f == "in-memory:" ++ moduleNameString debuggerViewClassModName-                          _ -> False) . GHC.targetId)-                      modName modContent >>= \case-                    Failed -> do-                      ghcLog <& DebuggerLog Logger.Info-                        (LogFailedToCompileDebugViewModule modName)-                      return []-                    Succeeded -> do-                      return [modName]-                else do+            tryLoadHsDebuggerViewModule l if_cache (const False) debuggerViewClassModName debuggerViewClassContents+              >>= \case+                Failed -> do+                  -- Failed to load base debugger-view module!                   ghcLog <& DebuggerLog Logger.Debug-                    (LogSkippingViewModuleNoPkg modName pkgName (map unitIdString base_dep_uids))+                    (LogFailedToCompileDebugViewModule debuggerViewClassModName)                   return []+                Succeeded -> (debuggerViewClassModName:) . concat <$> do -      Just uid ->-        -- TODO: We assume for now that if you depended on-        -- @haskell-debugger-view@, then you also depend on all its transitive-        -- dependencies (containers, text, ...), thus can load all custom-        -- views. Hence all `debuggerViewBuiltinMods`. In the future, we-        -- may want to guard all dependencies behind cabal flags that the user-        -- can tweak when depending on `haskell-debugger-view`.-        return (uid, map fst debuggerViewBuiltinMods)+                  forM debuggerViewInstancesMods $ \(modName, modContent, pkgName) -> do+                    -- Don't try to load instances whose packages are not even in+                    -- the module graph:+                    if any ((pkgName `L.isPrefixOf`) . unitIdString) base_dep_uids then do+                      tryLoadHsDebuggerViewModule l if_cache+                          ((\case+                              -- Keep only "GHC.Debugger.View.Class", which is a dependency of all these.+                              GHC.TargetFile f _+                                -> f == "in-memory:" ++ moduleNameString debuggerViewClassModName+                              _ -> False) . GHC.targetId)+                          modName modContent >>= \case+                        Failed -> do+                          ghcLog <& DebuggerLog Logger.Info+                            (LogFailedToCompileDebugViewModule modName)+                          return []+                        Succeeded -> do+                          return [modName]+                    else do+                      ghcLog <& DebuggerLog Logger.Debug+                        (LogSkippingViewModuleNoPkg modName pkgName (map unitIdString base_dep_uids))+                      return [] -    -- Final load combining all base modules plus haskell-debugger-view ones that loaded successfully-    -- The targets which were successfully loaded have been set with `setTarget` (e.g. by setupHomeUnitGraph).-    final_mod_graph <- doDownsweep (Just mod_graph_base{-cached previous result-})-    success <- doLoad if_cache GHC.LoadAllTargets final_mod_graph-    when (GHC.failed success) $ liftIO $-      throwM DebuggerFailedToLoad+          Just uid ->+            -- TODO: We assume for now that if you depended on+            -- @haskell-debugger-view@, then you also depend on all its transitive+            -- dependencies (containers, text, ...), thus can load all custom+            -- views. Hence all `debuggerViewBuiltinMods`. In the future, we+            -- may want to guard all dependencies behind cabal flags that the user+            -- can tweak when depending on `haskell-debugger-view`.+            return (uid, map fst debuggerViewBuiltinMods) -    -- Set interactive context to import all loaded modules-    let preludeImp = GHC.IIDecl . GHC.simpleImportDecl $ GHC.mkModuleName "Prelude"-    -- dbgView should always be available, either because we manually loaded it-    -- or because it's in the transitive closure.-    let dbgViewImps-          -- Using in-memory hs-dbg-view. It's a home-unit, so refer to it directly-          | hdv_uid == hsDebuggerViewInMemoryUnitId-          = map (GHC.IIModule . mkModule (RealUnit (Definite hdv_uid))) loadedBuiltinModNames-          -- It's available in a unit in the transitive closure. Resolve it.-          | otherwise-          = map (\mn ->-              GHC.IIDecl (GHC.simpleImportDecl mn)-              { ideclPkgQual = RawPkgQual-                  StringLiteral-                    { sl_st = NoSourceText-                    , sl_fs = mkFastString (unitIdString hdv_uid)-                    , sl_tc = Nothing-                    }-              }) loadedBuiltinModNames+        -- Final load combining all base modules plus haskell-debugger-view ones that loaded successfully+        -- The targets which were successfully loaded have been set with `setTarget` (e.g. by setupHomeUnitGraph).+        final_mod_graph <- doDownsweep (Just mod_graph_base{-cached previous result-})+        success <- doLoad if_cache GHC.LoadAllTargets final_mod_graph+        when (GHC.failed success) $ liftIO $+          throwM DebuggerFailedToLoad -    mss <- getAllLoadedModules+        -- Set interactive context to import all loaded modules+        let preludeImp = GHC.IIDecl . GHC.simpleImportDecl $ GHC.mkModuleName "Prelude"+        -- dbgView should always be available, either because we manually loaded it+        -- or because it's in the transitive closure.+        let dbgViewImps+              -- Using in-memory hs-dbg-view. It's a home-unit, so refer to it directly+              | hdv_uid == hsDebuggerViewInMemoryUnitId+              = map (GHC.IIModule . mkModule (RealUnit (Definite hdv_uid))) loadedBuiltinModNames+              -- It's available in a unit in the transitive closure. Resolve it.+              | otherwise+              = map (\mn ->+                  GHC.IIDecl (GHC.simpleImportDecl mn)+                  { ideclPkgQual = RawPkgQual+                      StringLiteral+                        { sl_st = NoSourceText+                        , sl_fs = mkFastString (unitIdString hdv_uid)+                        , sl_tc = Nothing+                        }+                  }) loadedBuiltinModNames -    GHC.setContext-      (preludeImp :-        dbgViewImps ++-        map (GHC.IIModule . GHC.ms_mod) mss)+        mss <- getAllLoadedModules -    -- See Note [External interpreter buffering]-    setBufferings <- compileExprRemote """-      do { System.IO.hSetBuffering System.IO.stdout System.IO.LineBuffering-         ; System.IO.hSetBuffering System.IO.stderr System.IO.LineBuffering }-      """-    hscInterp <$> GHC.getSession >>= \interp ->-      liftIO $ evalIO interp setBufferings+        GHC.setContext+          (preludeImp :+            dbgViewImps +++            map (GHC.IIModule . GHC.ms_mod) mss) -    runReaderT action-      =<< initialDebuggerState dbgLog-          (if loadedBuiltinModNames == []-            then Nothing-            else Just hdv_uid)+        -- See Note [External interpreter buffering]+        setBufferings <- compileExprRemote """+          do { System.IO.hSetBuffering System.IO.stdout System.IO.LineBuffering+             ; System.IO.hSetBuffering System.IO.stderr System.IO.LineBuffering }+          """+        hscInterp <$> GHC.getSession >>= \interp ->+          liftIO $ evalIO interp setBufferings++        runReaderT action+          =<< initialDebuggerState dbgLog+              (if loadedBuiltinModNames == []+                then Nothing+                else Just hdv_uid)++    fwd_thr <- liftIO $ async (void externalInterpFwdThread)+    liftIO $ link fwd_thr+    mainGhcThread  {- Note [Custom external interpreter]
haskell-debugger/GHC/Debugger/Runtime/Thread/Stack.hs view
@@ -211,8 +211,8 @@     let find_ixs_fv = Remote.raw $           "\\x -> let index_at n = GHC.Word.W16# (GHC.Base.indexWord16Array# x (n GHC.Exts.+# " ++ show bRK_FUN_offset ++ """#))                     in if (index_at 0# Data.Bits..&. 0xFF) == 66{-bci_BRK_FUN-} then-                        Just (index_at 1#, index_at 2#, index_at 3#, index_at 4#, index_at 5#)-                      else Nothing"""+                        Data.Maybe.Just (index_at 1#, index_at 2#, index_at 3#, index_at 4#, index_at 5#)+                      else Data.Maybe.Nothing"""     rs_fv <- expectRight =<< Remote.eval       (find_ixs_fv `Remote.app` Remote.untypedRef instrs_array_fv)
haskell-debugger/GHC/Debugger/Stopped/Exception.hs view
@@ -75,21 +75,23 @@ -- | This helper looks at the exception context for an exception, and retrieves -- the last entry of the HasCallStack backtrace. exceptionLocationExpr :: String-exceptionLocationExpr ="""+exceptionLocationExpr = """   let     fromCallStack cs = case Data.Maybe.listToMaybe (GHC.Exception.getCallStack cs) of-      Just (_, loc) -> Just ( GHC.Exception.srcLocFile loc-                            , GHC.Exception.srcLocStartLine loc-                            , GHC.Exception.srcLocStartCol loc)+      Data.Maybe.Just (_, loc)+        -> Data.Maybe.Just+          ( GHC.Exception.srcLocFile loc+          , GHC.Exception.srcLocStartLine loc+          , GHC.Exception.srcLocStartCol loc)     go exc =       let ctx = Control.Exception.someExceptionContext exc           bts :: [Control.Exception.Backtrace.Backtraces]           bts = Control.Exception.Context.getExceptionAnnotations ctx       in case bts of            bt : _ -> case GHC.Internal.Exception.Backtrace.btrHasCallStack bt of-             Just cs -> fromCallStack cs-             Nothing -> Nothing-           [] -> Nothing+             Data.Maybe.Just cs -> fromCallStack cs+             Data.Maybe.Nothing -> Data.Maybe.Nothing+           [] -> Data.Maybe.Nothing   in go """ @@ -147,31 +149,31 @@ -- We need a specific datatype because ExceptionInfoNode is recursive. exceptionInfoData :: String exceptionInfoData =-  "data ExceptionInfoNode = ExceptionInfoNode String String String (Maybe String) [ExceptionInfoNode]"+  "data ExceptionInfoNode = ExceptionInfoNode String String String (Data.Maybe.Maybe String) [ExceptionInfoNode]"  -- | Helper expression run in the debuggee that walks the exception context and -- populates the 'ExceptionInfoNode' structure. exceptionInfoExpr :: String exceptionInfoExpr = """-  let collectExceptionInfo :: SomeException -> ExceptionInfoNode+  let collectExceptionInfo :: Control.Exception.SomeException -> ExceptionInfoNode       collectExceptionInfo se' =         case se' of-          SomeException exc ->+          Control.Exception.SomeException exc ->             let ctx = Control.Exception.someExceptionContext se'                 rendered = Control.Exception.Context.displayExceptionContext ctx                 whileHandling = Control.Exception.Context.getExceptionAnnotations ctx-                innerNodes = map (collectExceptionInfo . unwrap) whileHandling+                innerNodes = Prelude.map (collectExceptionInfo Prelude.. unwrap) whileHandling                 simpleTypeName = Data.Typeable.tyConName tc                 modulePrefix = case Data.Typeable.tyConModule tc of-                  mdl | null mdl -> \"\"-                      | otherwise -> mdl ++ \".\"+                  mdl | Prelude.null mdl -> \"\"+                      | otherwise -> mdl Prelude.++ \".\"                 packagePrefix = case Data.Typeable.tyConPackage tc of-                  pkg | null pkg -> \"\"-                      | otherwise -> pkg ++ \":\"+                  pkg | Prelude.null pkg -> \"\"+                      | otherwise -> pkg Prelude.++ \":\"                 tc = Data.Typeable.typeRepTyCon (Data.Typeable.typeOf exc)-                fullTypeName = packagePrefix ++ modulePrefix ++ simpleTypeName+                fullTypeName = packagePrefix Prelude.++ modulePrefix Prelude.++ simpleTypeName                 unwrap (Control.Exception.WhileHandling inner) = inner-                contextText = if null rendered then Nothing else Just rendered+                contextText = if Prelude.null rendered then Data.Maybe.Nothing else Data.Maybe.Just rendered             in ExceptionInfoNode                  simpleTypeName                  fullTypeName
hdb/Development/Debug/Adapter/Handles.hs view
@@ -18,7 +18,6 @@ import GHC.IO.Handle import System.Process import Control.Exception-import Control.Monad import Control.Concurrent.Async  handleLogger :: Handle -> IO (LogAction IO T.Text)@@ -117,10 +116,16 @@  -- | Thread to read from the intercepted stdout pipe and forward onwards forwardingThread :: (T.Text -> IO ()) -> Handle -> IO ()-forwardingThread write_action fromPipe = forever $ do-  line <- T.hGetLine fromPipe-  write_action line-+forwardingThread write_action fromPipe = loop+  where+    loop = do+      eof <- hIsEOF fromPipe+      if eof+        then return ()+        else do+          line <- T.hGetLine fromPipe+          write_action line+          loop  withPipe :: (Handle -> Handle -> IO r) -> IO r withPipe action = bracket createPipe closeBoth (uncurry action)
hdb/Development/Debug/Adapter/Init.hs view
@@ -24,7 +24,7 @@ import System.IO import GHC.IO.Encoding import Control.Monad.Catch-import Control.Exception (SomeAsyncException, throwIO)+import Control.Exception (SomeAsyncException, throwIO, IOException) import Control.Concurrent import GHC.Conc.Sync (labelThread) import Control.Monad@@ -114,7 +114,26 @@    projectRoot <- maybe (liftIO getCurrentDirectory) pure givenRoot -  let hieBiosLogger = contramap DAPSessionSetupLog l+  -- Create a pipe to which messages to send to the DAP console are written and read.+  -- todo: This could just be a Haskell channel now...+  (readDAPOutput, writeDAPOutput) <- liftIO P.createPipe+  liftIO $ do+    hSetBuffering readDAPOutput LineBuffering+    hSetBuffering writeDAPOutput NoBuffering+    -- GHC output uses utf8+    hSetEncoding readDAPOutput utf8+    hSetEncoding writeDAPOutput utf8+    setLocaleEncoding utf8++  dapLogger <- liftIO $ handleLogger writeDAPOutput++  let hieBiosLogger = contramap DAPSessionSetupLog l <> logHieBiosToDAP++      logHieBiosToDAP = LogAction $ \case+        WithSeverity msg sev+          | sev >= Info -> dapLogger <& renderSessionSetupLog msg+          | otherwise -> mempty+   liftIO (runExceptT (hieBiosSetup hieBiosLogger projectRoot entryFile)) >>= \case     Left e              -> throwError $ InitFailed e     Right (Left e)      -> lift       $ exitWithMsg e@@ -126,12 +145,6 @@         hSetBuffering writeExternalIntStdin NoBuffering         hSetEncoding readExternalIntStdin utf8         hSetEncoding writeExternalIntStdin utf8-      when (not preferInternalInterpreter) $ liftIO $ void $ do-        -- forward proxy in to external interpreter stdin-        forkIO $ forever $ do-          i <- readChan syncProxyIn-          -- 3. Write to write-end of the pipe-          BS.hPut writeExternalIntStdin i >> hFlush writeExternalIntStdin        let nextFreshId = 0           breakpointMap = mempty@@ -144,21 +157,10 @@             , externalInterpreterStdinStream = UseHandle readExternalIntStdin             } -      -- Create a pipe to which messages to send to the DAP console are written and read.-      -- todo: This could just be a Haskell channel now...-      (readDAPOutput, writeDAPOutput) <- liftIO P.createPipe-      liftIO $ do-        hSetBuffering readDAPOutput LineBuffering-        hSetBuffering writeDAPOutput NoBuffering-        -- GHC output uses utf8-        hSetEncoding readDAPOutput utf8-        hSetEncoding writeDAPOutput utf8-        setLocaleEncoding utf8-       finished_init <- liftIO $ newEmptyMVar        dbgLog <- liftIO $-        createDebuggerLogger l writeDAPOutput (supportsRunInTerminal, syncProxyOut, syncProxyErr)+        createDebuggerLogger l dapLogger writeDAPOutput (supportsRunInTerminal, syncProxyOut, syncProxyErr)        let absEntryFile = normalise $ projectRoot </> entryFile       lift $ registerNewDebugSession (maybe "debug-session" T.pack __sessionId) DAS{entryFile=absEntryFile,..}@@ -173,6 +175,14 @@         , if preferInternalInterpreter then stdinForwardThread  supportsRunInTerminal syncProxyIn  else mempty         , if preferInternalInterpreter then stdoutCaptureThread supportsRunInTerminal syncProxyOut else mempty         , if preferInternalInterpreter then stderrCaptureThread supportsRunInTerminal syncProxyErr else mempty+        , if preferInternalInterpreter+            then mempty+            else const $ do+              -- forward proxy in to external interpreter stdin+              forever $ do+                i <- readChan syncProxyIn+                -- 3. Write to write-end of the pipe+                BS.hPut writeExternalIntStdin i >> hFlush writeExternalIntStdin         ]        -- Do not return until the initialization is finished@@ -275,11 +285,11 @@ -- See Note [Debugger, debuggee, and DAP logs] createDebuggerLogger   :: LogAction IO DAPLog-  -> Handle -- ^ Handle to write to DAP output+  -> LogAction IO T.Text -- ^ Logger that writes to to DAP output+  -> Handle              -- ^ Handle to DAP output   -> (Bool, Chan BS.ByteString, Chan BS.ByteString) -- ^ Proxy channels, and whether is supported   -> IO (LogAction IO Debugger.DebuggerLog)-createDebuggerLogger l writeDAPOutput (supportsRunInTerminal, syncProxyOut, syncProxyErr) = do-  dapLogger <- handleLogger writeDAPOutput+createDebuggerLogger l dapLogger writeDAPOutput (supportsRunInTerminal, syncProxyOut, syncProxyErr) = do   return $     -- (1) (all output is logged to normal logger)     contramap DAPDebuggerLog l <>@@ -342,7 +352,10 @@         writeChan syncOut $ T.encodeUtf8 (line <> T.pack "\n")        -- Always output to Debug Console-      withAdaptor $ Output.stdout line+      catch+        (withAdaptor $ Output.stdout line)+        (\(_ :: IOException) ->+          throwIO (FailedToWriteToAdaptor line))  -- | Like 'stdoutCaptureThread' but for stderr stderrCaptureThread :: Bool -> Chan BS.ByteString -> (DebugAdaptorCont () -> IO ()) -> IO ()@@ -358,7 +371,7 @@       -- Always output to Debug Console       catch         (withAdaptor $ Output.stderr line)-        (\(_ :: SomeException) ->+        (\(_ :: IOException) ->           throwIO (FailedToWriteToAdaptor line))  newtype FailedToWriteToAdaptor = FailedToWriteToAdaptor T.Text
hdb/Development/Debug/Adapter/Proxy.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, DerivingStrategies #-}+{-# LANGUAGE BlockArguments, 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@@ -8,6 +8,7 @@  import DAP +import Control.Concurrent.Async import System.IO import System.Exit (exitSuccess) import System.Environment@@ -55,33 +56,34 @@    port <- liftIO $ socketPort sock -  _ <- liftIO $ forkIO $ ignoreIOException $ do+  fwd_thr <- liftIO $ async $ ignoreIOException $ do     myThreadId >>= \tid -> labelThread tid "Debug/Adapter/Proxy: TCP Server"     runTCPServerWithSocket sock $ \scket -> do        infoMsg (T.pack $ "Connected to client on port " ++ show port ++ "...!")       putMVar client_conn_signal () -- signal ready (see #95) -      -- -- Read stdout from chan and write to socket-      _ <- forkIO $ ignoreIOException $ do-        tid <- myThreadId-        labelThread tid "Debug/Adapter/Proxy: Forward stdout"-        forever $ do-          bs <- readChan dbOut-          debugMsg (T.pack $ "Writing to socket: " ++ BS8.unpack bs)-          NBS.sendAll scket bs--      -- Read stderr from chan and write to socket-      _ <- forkIO $ ignoreIOException $ do-        tid <- myThreadId-        labelThread tid "Debug/Adapter/Proxy: Forward stderr"-        forever $ do-          bs <- readChan dbErr-          debugMsg (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+      race_+        (race_+          (-- Read stdout from chan and write to socket+           ignoreIOException $ do+             tid <- myThreadId+             labelThread tid "Debug/Adapter/Proxy: Forward stdout"+             forever $ do+               bs <- readChan dbOut+               debugMsg (T.pack $ "Writing to socket: " ++ BS8.unpack bs)+               NBS.sendAll scket bs)+          (-- Read stderr from chan and write to socket+           ignoreIOException $ do+             tid <- myThreadId+             labelThread tid "Debug/Adapter/Proxy: Forward stderr"+             forever $ do+               bs <- readChan dbErr+               debugMsg (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             if BS8.null bs               then do@@ -90,8 +92,9 @@               else do                 debugMsg (T.pack $ "Read from socket: " ++ BS8.unpack bs)                 writeChan dbIn bs >> loop-       in ignoreIOException loop+          in ignoreIOException loop) +  liftIO $ link fwd_thr   sendRunProxyInTerminal port    where@@ -120,22 +123,22 @@   catch (     runTCPClient "127.0.0.1" (show port) $ \sock -> do       -- Forward stdin to sock-      _ <- forkIO $-        catch (forever $ do+      concurrently_+        (catch (forever $ do           str <- BS8.hGetLine stdin           NBS.sendAll sock (str <> BS8.pack "\n")-          ) $ \(_e::IOException) -> return () -- connection dropped, just exit.+          ) $ \(_e::IOException) -> return ()) -- connection dropped, just exit. -      -- Forward stdout from sock-      catch (forever $ do-        msg <- NBS.recv sock 4096-        if BS8.null msg-          then do-            l <& WithSeverity (T.pack "Exiting...") Info-            close sock-            exitSuccess-          else BS8.hPut stdout msg >> hFlush stdout-        ) $ \(_e::IOException) -> return () -- connection dropped, just exit.+        (-- Forward stdout from sock+        catch (forever $ do+          msg <- NBS.recv sock 4096+          if BS8.null msg+            then do+              l <& WithSeverity (T.pack "Exiting...") Info+              close sock+              exitSuccess+            else 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 start running successfully?"@@ -150,12 +153,13 @@       , projectRoot } <- getDebugSession   let debuggee_inv = T.pack $ makeRelative projectRoot entryFile ++ ":" ++ entryPoint ++                               (if null entryArgs then "" else " ") ++ unwords entryArgs+  thisProg <- liftIO getExecutablePath -- run the same `hdb` executable in `proxy` mode   sendRunInTerminalReverseRequest     RunInTerminalRequestArguments       { runInTerminalRequestArgumentsKind = Just RunInTerminalRequestArgumentsKindIntegrated       , runInTerminalRequestArgumentsTitle = Just debuggee_inv       , runInTerminalRequestArgumentsCwd = ""-      , runInTerminalRequestArgumentsArgs = ["hdb", "proxy", "--port", T.pack (show port)]+      , runInTerminalRequestArgumentsArgs = [T.pack thisProg, "proxy", "--port", T.pack (show port)]       , runInTerminalRequestArgumentsEnv = Just (H.singleton "DEBUGGEE_INVOCATION" debuggee_inv)       , runInTerminalRequestArgumentsArgsCanBeInterpretedByShell = False       }
hdb/Development/Debug/Options.hs view
@@ -8,13 +8,14 @@  -- | The options `hdb` is invoked in the command line with data HdbOptions-  -- | @server [--internal-interpreter] --port <port>@+  -- | @server [--internal-interpreter] [--disable-ipe-backtraces] --port <port>@   = HdbDAPServer     { port :: Int     , verbosity :: Severity     , internalInterpreter :: Bool+    , disableIpeBacktraces :: Bool     }-  -- | @cli [--internal-interpreter] [--entry-point=<entryPoint>] [--extra-ghc-args="<args>"] [<entryFile>] -- [<entryArgs>]@+  -- | @cli [--internal-interpreter] [--disable-ipe-backtraces] [--entry-point=<entryPoint>] [--extra-ghc-args="<args>"] [<entryFile>] -- [<entryArgs>]@   | HdbCLI     { entryPoint :: String     , entryFile :: FilePath@@ -22,6 +23,7 @@     , extraGhcArgs :: [String]     , verbosity :: Severity     , internalInterpreter :: Bool+    , disableIpeBacktraces :: Bool     , debuggeeStdin :: Maybe FilePath     }
hdb/Development/Debug/Options/Parser.hs view
@@ -29,6 +29,7 @@      <> help "DAP server port" )   <*> verbosityParser Debug   <*> internalInterpreterParser+  <*> disableIpeBacktracesParser  -- | Parser for 'HdbCLI' options cliParser :: Parser HdbOptions@@ -55,6 +56,7 @@      <> help "Additional flags to pass to the ghc invocation that loads the program for debugging" )   <*> verbosityParser Warning   <*> internalInterpreterParser+  <*> disableIpeBacktracesParser   <*> (optional $ strOption       ( long "debuggee-stdin"      <> metavar "FILE"@@ -151,6 +153,22 @@   switch     ( long "internal-interpreter"    <> help "Prefer running the debuggee on the debugger's internal interpreter rather than on a separate (external-interpreter) process"+    )++-- | Parser for --disable-ipe-backtraces+--+-- Disable IPE backtrace information in the debugger. By default, IPE backtraces+-- are enabled to provide better crash diagnostics when debugging Haskell programs.+-- However, when using the internal interpreter, IPE backtraces appear in the+-- debugger output but not with the external interpreter (since they run as+-- separate processes). Use this flag only if you need consistent test output+-- between internal and external interpreter modes, or when testing behavior that+-- should not include IPE backtrace information.+disableIpeBacktracesParser :: Parser Bool+disableIpeBacktracesParser =+  switch+    ( long "disable-ipe-backtraces"+   <> help "Disable IPE backtrace info for consistent output between internal/external interpreter modes"     )  -- | Main parser info
hdb/Development/Debug/Session/Setup.hs view
@@ -11,6 +11,7 @@    -- * Logging   , SessionSetupLog(..)+  , renderSessionSetupLog   ) where  import Control.Applicative ((<|>))@@ -43,12 +44,20 @@ import qualified Hie.Yaml as Implicit  import Colog.Core+import Prettyprinter+import Prettyprinter.Render.Text  data SessionSetupLog   = HieBiosLog HIE.Log   | LogCradle (HIE.Cradle Void)   | LogSetupMsg T.Text   deriving Show++renderSessionSetupLog :: SessionSetupLog -> T.Text+renderSessionSetupLog = \case+  HieBiosLog l -> renderStrict $ layoutPretty defaultLayoutOptions $ pretty l+  LogCradle c -> T.pack $ "Using cradle: " ++ show c+  LogSetupMsg m -> m  -- | Flags inferred by @hie-bios@ to invoke GHC data HieBiosFlags = HieBiosFlags
hdb/Main.hs view
@@ -55,7 +55,6 @@ main = do   setBacktraceMechanismState CostCentreBacktrace False   setBacktraceMechanismState HasCallStackBacktrace True-  setBacktraceMechanismState IPEBacktrace False -- TODO: True, see #181    allArgs <- getArgs   hdbOpts <- case allArgs of@@ -66,7 +65,8 @@          pure (HdbExternalInterpreter (read writeFd) (read readFd))     _ -> parseHdbOptions   case hdbOpts of-    HdbDAPServer{port, internalInterpreter} -> do+    HdbDAPServer{port, internalInterpreter, disableIpeBacktraces} -> do+      setBacktraceMechanismState IPEBacktrace (not disableIpeBacktraces)       config <- getConfig port       redirectRealStdout internalInterpreter $ \realStdout -> do         hSetBuffering realStdout LineBuffering@@ -78,6 +78,7 @@           (talk l init_var pid_var ccon_var internalInterpreter)           (ack l pid_var)     HdbCLI{..} -> do+        setBacktraceMechanismState IPEBacktrace (not disableIpeBacktraces)         l <- mainLogger hdbOpts.verbosity stdout         stdinStream <- case debuggeeStdin of           Just fp -> UseHandle <$> System.IO.openFile fp ReadMode@@ -91,6 +92,7 @@         runIDM (contramap InteractiveLog l) entryPoint entryFile entryArgs extraGhcArgs           runConf debugInteractive     HdbProxy{port} -> do+        setBacktraceMechanismState IPEBacktrace True         l <- mainLogger hdbOpts.verbosity stdout         runInTerminalHdbProxy (contramap RunProxyClientLog l) port     HdbExternalInterpreter{writeFd, readFd} -> do@@ -213,7 +215,13 @@ talk l support_rit_var _pid_var client_proxy_signal prefer_internal_interpreter = \ case   CommandInitialize -> do     InitializeRequestArguments{supportsRunInTerminalRequest} <- getArguments+#ifdef mingw32_HOST_OS+    -- On Windows, runInTerminal is currently unsupported+    -- See #199+    let runInTerminal = False+#else     let runInTerminal = fromMaybe False supportsRunInTerminalRequest+#endif     liftIO $ writeIORef support_rit_var runInTerminal     sendInitializeResponse
+ test/golden/T130/T130.hdb-stdin view
@@ -0,0 +1,1 @@+run
+ test/golden/T130/T130.hdb-stdout view
@@ -0,0 +1,1 @@+Cannot use unsupported haskell-debugger-view version found in the transitive closure: 0.1.0.0 (supported: 0.2 <= && < 0.3)
+ test/golden/T130/T130.hdb-test view
@@ -0,0 +1,12 @@+#!/bin/sh++# the pkgdb is filled in by hie-bios+# this test should fail because we are using haskell-debugger-view == 0.1.0.0+# which is not supported by this debugger version.+# (Note: drop the output because the callstack is hard to normalize)++if ($HDB app/Main.hs 2>&1 | grep "Cannot use unsupported") < T130.hdb-stdin; then+    exit 0+fi++echo "Expecting UnsupportedHsDbgViewVersion but didn't find that error in the debugger output:"
+ test/golden/T130/app/Main.hs view
@@ -0,0 +1,7 @@+module Main (main) where++import Lib++main :: IO ()+main = print my+
+ test/golden/T130/lib/Lib.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE DerivingVia, StandaloneDeriving #-}+module Lib where++import GHC.Debugger.View.Class++data MyType = MyType deriving Show+deriving via (BoringTy MyType) instance (DebugView MyType)++my :: MyType+my = MyType+
+ test/golden/T130b/T130b.hdb-stdin view
@@ -0,0 +1,1 @@+run
+ test/golden/T130b/T130b.hdb-stdout view
@@ -0,0 +1,4 @@+[1 of 2] Compiling Main             ( <TEMPORARY-DIRECTORY>/app/Main.hs, interpreted )[T130b-0.1.0.0-inplace-T130b]+(hdb) MyType+()+(hdb) Exiting...
+ test/golden/T130b/T130b.hdb-test view
@@ -0,0 +1,6 @@+#!/bin/sh++# the pkgdb is filled in by hie-bios+# this test should succeed because we are using a supported+#   haskell-debugger-view (== 0.2.0.0), unlike for `T130`+$HDB -v0 app/Main.hs 2>&1 < T130b.hdb-stdin || true
+ test/golden/T130b/app/Main.hs view
@@ -0,0 +1,7 @@+module Main (main) where++import Lib++main :: IO ()+main = print my+
+ test/golden/T130b/lib/Lib.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE DerivingVia, StandaloneDeriving #-}+module Lib where++import GHC.Debugger.View.Class++data MyType = MyType deriving Show+deriving via (BoringTy MyType) instance (DebugView MyType)++my :: MyType+my = MyType+
+ test/golden/T135/T135.hdb-stdin view
@@ -0,0 +1,1 @@+run
+ test/golden/T135/T135.hdb-stdout view
@@ -0,0 +1,13 @@+[1 of 3] Compiling GHC.Debugger.View.Class ( in-memory:GHC.Debugger.View.Class, interpreted )[haskell-debugger-view-in-memory]+[2 of 3] Compiling Main             ( <TEMPORARY-DIRECTORY>/myapp/app/Main.hs, interpreted )[myapp-0.1.0.0-inplace-myapp]+[;1m<TEMPORARY-DIRECTORY>/myapp/app/Main.hs:3:1: [;1m[35mwarning[0m[0m[;1m: [GHC-66111] [[;1m[35m-Wunused-imports[0m[0m[;1m][0m[0m[;1m+    The import of ‘MyLib’ is redundant+      except perhaps to import instances from ‘MyLib’+    To import instances alone, use: import MyLib()[0m[0m+[;1m[34m  |[0m[0m+[;1m[34m3 |[0m[0m [;1m[35mimport MyLib (someFunc)[0m[0m+[;1m[34m  |[0m[0m[;1m[35m ^^^^^^^^^^^^^^^^^^^^^^^[0m[0m++(hdb) Hello, Haskell!+()+(hdb) Exiting...
+ test/golden/T135/T135.hdb-test view
@@ -0,0 +1,7 @@+#!/bin/sh+# mkdir -p mystore+# STORE=$PWD/mystore+# hie-bios already handles setting up its own pkgdb I think+# (cd mylib && cabal -v0 --store-dir="$STORE" install --lib --package-env .)+# MYPKGDB=$(echo "$STORE"/ghc-*/package.db)+$HDB -v0 myapp/app/Main.hs < T135.hdb-stdin # the pkgdb is filled in by hie-bios (--extra-ghc-args -package-db="$MYPKGDB")
+ test/golden/T135/myapp/app/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import MyLib (someFunc)++main :: IO ()+main = putStrLn "Hello, Haskell!"
+ test/golden/T135/mylib/src/MyLib.hs view
@@ -0,0 +1,4 @@+module MyLib (someFunc) where++someFunc :: IO ()+someFunc = putStrLn "someFunc"
+ test/golden/T154/Main.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "hello"
+ test/golden/T154/T154.hdb-stdout view
@@ -0,0 +1,5 @@+[1 of 3] Compiling GHC.Debugger.View.Class ( in-memory:GHC.Debugger.View.Class, interpreted )[haskell-debugger-view-in-memory]+[2 of 3] Compiling Main             ( <TEMPORARY-DIRECTORY>/Main.hs, interpreted )[main]+(hdb) hello+()+(hdb) Exiting...
+ test/golden/T154/T154.hdb-test view
@@ -0,0 +1,3 @@+#!/bin/sh++echo "run" | $HDB -v0 Main.hs --extra-ghc-args -fexternal-interpreter 2>&1
+ test/golden/T159/T159.hdb-stdin view
@@ -0,0 +1,3 @@+break T159.hs 12+run+backtrace
+ test/golden/T159/T159.hdb-stdout view
@@ -0,0 +1,6 @@+[1 of 3] Compiling GHC.Debugger.View.Class ( in-memory:GHC.Debugger.View.Class, interpreted )[haskell-debugger-view-in-memory]+[2 of 3] Compiling Main             ( <TEMPORARY-DIRECTORY>/T159.hs, interpreted )[main]+(hdb) BreakFound {changed = True, breakId = [InternalBreakpointId Main 16], sourceSpan = SourceSpan {file = "<TEMPORARY-DIRECTORY>/T159.hs", startLine = 12, endLine = 12, startCol = 3, endCol = 47}}+(hdb) Stopped at breakpoint+(hdb) [DbgStackFrame {name = "Main.foo", sourceSpan = SourceSpan {file = "<TEMPORARY-DIRECTORY>/T159.hs", startLine = 12, endLine = 12, startCol = 3, endCol = 47}, breakId = Just InternalBreakpointId Main 16},DbgStackFrame {name = "Lovely annotation", sourceSpan = SourceSpan {file = "", startLine = 0, endLine = 0, startCol = 0, endCol = 0}, breakId = Nothing},DbgStackFrame {name = "[1,2,3,4]", sourceSpan = SourceSpan {file = "", startLine = 0, endLine = 0, startCol = 0, endCol = 0}, breakId = Nothing},DbgStackFrame {name = "annotateCallStackIO, called at <TEMPORARY-DIRECTORY>/T159.hs:5:3 in main:Main", sourceSpan = SourceSpan {file = "", startLine = 0, endLine = 0, startCol = 0, endCol = 0}, breakId = Nothing}]+(hdb) Exiting...
+ test/golden/T159/T159.hdb-test view
@@ -0,0 +1,3 @@+#!/bin/sh++$HDB -v0 T159.hs < T159.hdb-stdin
+ test/golden/T159/T159.hs view
@@ -0,0 +1,12 @@+import GHC.Stack.Annotation.Experimental++main :: IO ()+main = do+  annotateCallStackIO $ do+    annotateStackShowIO ([1..4] :: [Int]) $ do+      annotateStackStringIO "Lovely annotation" $ do+        foo 500++foo :: Int -> IO ()+foo arg =+  putStrLn $ "foo: " <> show (arg * arg * arg)
+ test/golden/T164/Main.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE GADTs, ImplicitParams #-}+{-# LANGUAGE BangPatterns #-}++module Main where++import Data.Word++data Foo where+  Foo :: Show a => a -> Foo++data Foo2 where+  Foo2 :: Show a => { foo :: a }-> Foo2++data Foo3 where+  Foo3 :: Int -> {-# UNPACK #-} !Word -> !Int -> !Int -> Foo3++data Foo4 = Foo4 !Word32 !Word16 !Word64 !Word16++instance Show Foo where+  show (Foo a) = show a++data Foo5 where+  Foo5 :: (?impl :: String) => String -> Foo5++mkFoo :: Foo+mkFoo = Foo $! ("value" :: String)++mkFoo2 :: Foo2+mkFoo2 = Foo2 $! ("value2" :: String)++mkFoo5 :: Foo5+mkFoo5 = let ?impl = "bob" in Foo5 "alice"+++inspectFoo :: IO ()+inspectFoo = do+  let !existentialFoo = mkFoo+  let !existentialFoo2 = mkFoo2+  let !foo3 = Foo3 0 1 2 3+  let !foo4 = Foo4 0 1 2 3+  let !foo5 = mkFoo5+  const (pure ()) (existentialFoo, existentialFoo2, foo3, foo4, foo5)+  case existentialFoo of+    Foo inner -> putStrLn (show inner)++main :: IO ()+main = inspectFoo
+ test/golden/T164/T164.hdb-stdin view
@@ -0,0 +1,4 @@+break Main.hs 42+run+variables+exit
+ test/golden/T164/T164.hdb-stdout view
@@ -0,0 +1,27 @@+[1 of 3] Compiling GHC.Debugger.View.Class ( in-memory:GHC.Debugger.View.Class, interpreted )[haskell-debugger-view-in-memory]+[2 of 3] Compiling Main             ( <TEMPORARY-DIRECTORY>/Main.hs, interpreted )[main]+(hdb) BreakFound {changed = True, breakId = [InternalBreakpointId Main 5], sourceSpan = SourceSpan {file = "<TEMPORARY-DIRECTORY>/Main.hs", startLine = 42, endLine = 42, startCol = 3, endCol = 70}}+(hdb) Stopped at breakpoint+(hdb) _result : IO () = _+*** Ignoring breakpoint [<TEMPORARY-DIRECTORY>/Main.hs:42:3-69]+  _result : IO () = _+existentialFoo : Foo = Foo+  _1 : r0 = _+  _2 : [Char] = "value"+existentialFoo2 : Foo2 = Foo2+  _1 : r0 = _+  foo : [Char] = "value2"+foo3 : Foo3 = Foo3+  _1 : Int = 0+  _2 : Word = 1+  _3 : Int = 2+  _4 : Int = 3+foo4 : Foo4 = Foo4+  _1 : Word32 = 0+  _2 : Word16 = 1+  _3 : Word64 = 2+  _4 : Word16 = 3+foo5 : Foo5 = Foo5+  _1 : ?impl::String = _+  _2 : String = _+(hdb)
+ test/golden/T164/T164.hdb-test view
@@ -0,0 +1,1 @@+$HDB Main.hs -v 0 < T164.hdb-stdin
+ test/golden/T169/Main.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "hello"
+ test/golden/T169/T169.hdb-stdout view
@@ -0,0 +1,5 @@+[1 of 3] Compiling GHC.Debugger.View.Class ( in-memory:GHC.Debugger.View.Class, interpreted )[haskell-debugger-view-in-memory]+[2 of 3] Compiling Main             ( <TEMPORARY-DIRECTORY>/Main.hs, interpreted )[main]+(hdb) hello+()+(hdb) Exiting...
+ test/golden/T169/T169.hdb-test view
@@ -0,0 +1,3 @@+#!/bin/sh++echo "run" | $HDB -v0 Main.hs --extra-ghc-args -fno-external-interpreter 2>&1
+ test/golden/T169/T169b.hdb-stdin view
@@ -0,0 +1,5 @@+break --name main+run+next+next+next
+ test/golden/T169/T169b.hdb-stdout view
@@ -0,0 +1,10 @@+[1 of 3] Compiling GHC.Debugger.View.Class ( in-memory:GHC.Debugger.View.Class, interpreted )[haskell-debugger-view-in-memory]+[2 of 3] Compiling Main             ( <TEMPORARY-DIRECTORY>/T169b.hs, interpreted )[main]+(hdb) BreakFound {changed = True, breakId = [InternalBreakpointId Main 4], sourceSpan = SourceSpan {file = "<TEMPORARY-DIRECTORY>/T169b.hs", startLine = 6, endLine = 8, startCol = 8, endCol = 58}}+(hdb) Stopped at breakpoint+(hdb) [ScopeInfo {kind = LocalVariablesScope, sourceSpan = SourceSpan {file = "<TEMPORARY-DIRECTORY>/T169b.hs", startLine = 7, endLine = 7, startCol = 3, endCol = 58}, numVars = Nothing, expensive = False},ScopeInfo {kind = ModuleVariablesScope, sourceSpan = SourceSpan {file = "<TEMPORARY-DIRECTORY>/T169b.hs", startLine = 7, endLine = 7, startCol = 3, endCol = 58}, numVars = Just 2, expensive = True},ScopeInfo {kind = GlobalVariablesScope, sourceSpan = SourceSpan {file = "<TEMPORARY-DIRECTORY>/T169b.hs", startLine = 7, endLine = 7, startCol = 3, endCol = 58}, numVars = Just 353, expensive = True}]+(hdb) Debuggee writing something to stdout+[ScopeInfo {kind = LocalVariablesScope, sourceSpan = SourceSpan {file = "<TEMPORARY-DIRECTORY>/T169b.hs", startLine = 8, endLine = 8, startCol = 3, endCol = 58}, numVars = Nothing, expensive = False},ScopeInfo {kind = ModuleVariablesScope, sourceSpan = SourceSpan {file = "<TEMPORARY-DIRECTORY>/T169b.hs", startLine = 8, endLine = 8, startCol = 3, endCol = 58}, numVars = Just 2, expensive = True},ScopeInfo {kind = GlobalVariablesScope, sourceSpan = SourceSpan {file = "<TEMPORARY-DIRECTORY>/T169b.hs", startLine = 8, endLine = 8, startCol = 3, endCol = 58}, numVars = Just 353, expensive = True}]+(hdb) Debuggee writing something to stderr+()+(hdb) Exiting...
+ test/golden/T169/T169b.hdb-test view
@@ -0,0 +1,3 @@+#!/bin/sh++$HDB -v0 T169b.hs < T169b.hdb-stdin 2>&1
+ test/golden/T169/T169b.hs view
@@ -0,0 +1,8 @@+module Main where++import System.IO++main :: IO ()+main = do+  hPutStrLn stdout "Debuggee writing something to stdout"+  hPutStrLn stderr "Debuggee writing something to stderr"
+ test/golden/T169/T169c.debuggee-stdin view
@@ -0,0 +1,2 @@+hello there+
+ test/golden/T169/T169c.external.hdb-stdout view
@@ -0,0 +1,5 @@+[1 of 3] Compiling GHC.Debugger.View.Class ( in-memory:GHC.Debugger.View.Class, interpreted )[haskell-debugger-view-in-memory]+[2 of 3] Compiling Main             ( <TEMPORARY-DIRECTORY>/T169c.hs, interpreted )[main]+(hdb) "hello there"+()+(hdb) Exiting...
+ test/golden/T169/T169c.external.hdb-test view
@@ -0,0 +1,3 @@+#!/bin/sh++$HDB -v0 T169c.hs --debuggee-stdin T169c.debuggee-stdin < T169c.hdb-stdin 2>&1
+ test/golden/T169/T169c.hdb-stdin view
@@ -0,0 +1,1 @@+run
+ test/golden/T169/T169c.hs view
@@ -0,0 +1,6 @@+module Main where++main :: IO ()+main = do+  line <- getLine+  print line
+ test/golden/T169/T169c.internal.hdb-stdin view
@@ -0,0 +1,2 @@+run+hello world
+ test/golden/T169/T169c.internal.hdb-stdout view
@@ -0,0 +1,5 @@+[1 of 3] Compiling GHC.Debugger.View.Class ( in-memory:GHC.Debugger.View.Class, interpreted )[haskell-debugger-view-in-memory]+[2 of 3] Compiling Main             ( <TEMPORARY-DIRECTORY>/T169c.hs, interpreted )[main]+(hdb) "hello world"+()+(hdb) Exiting...
+ test/golden/T169/T169c.internal.hdb-test view
@@ -0,0 +1,3 @@+#!/bin/sh++$HDB -v0 T169c.hs < T169c.internal.hdb-stdin 2>&1
+ test/golden/T61/T61.hdb-stdin view
@@ -0,0 +1,1 @@+run
+ test/golden/T61/T61.hdb-stdout view
@@ -0,0 +1,5 @@+[1 of 3] Compiling GHC.Debugger.View.Class ( in-memory:GHC.Debugger.View.Class, interpreted )[haskell-debugger-view-in-memory]+[2 of 3] Compiling Main             ( <TEMPORARY-DIRECTORY>/x/Main.hs, interpreted )[main]+(hdb) wrks+()+(hdb) Exiting...
+ test/golden/T61/T61.hdb-test view
@@ -0,0 +1,1 @@+$HDB x/Main.hs < T61.hdb-stdin
+ test/golden/T61/x/Main.hs view
@@ -0,0 +1,1 @@+main = putStrLn "wrks"
+ test/golden/T79/T79.hdb-stdout view
@@ -0,0 +1,14 @@+[Info] Using cabal specification: <VERSION>+[Warn] unknown license type, you must put a copy in LICENSE yourself.+[Info] Creating fresh file CHANGELOG.md...+[Info] Creating fresh directory ./app...+[Info] Creating fresh file app/Main.hs...+[Info] Creating fresh file T79-tmp.cabal...+[Warn] No synopsis given. You should edit the .cabal file and add one.+[Info] You may want to edit the .cabal file and add a Description field.++[1 of 3] Compiling GHC.Debugger.View.Class ( in-memory:GHC.Debugger.View.Class, interpreted )[haskell-debugger-view-in-memory]+[2 of 3] Compiling Main             ( <TEMPORARY-DIRECTORY>/app/Main.hs, interpreted )[T79-tmp-0.1.0.0-inplace-T79-tmp]+(hdb) Hello, Haskell!+()+(hdb)
+ test/golden/T79/T79.hdb-test view
@@ -0,0 +1,4 @@+cabal init -m -n -d base -p T79-tmp && $HDB app/Main.hs <<'EOF'+run+exit+EOF
+ test/golden/T83/Main.hs view
@@ -0,0 +1,3 @@+module Main where++main = putStrLn "Heli"
+ test/golden/T83/T83.hdb-stdin view
@@ -0,0 +1,1 @@+run
+ test/golden/T83/T83.hdb-stdout view
@@ -0,0 +1,5 @@+[1 of 3] Compiling GHC.Debugger.View.Class ( in-memory:GHC.Debugger.View.Class, interpreted )[haskell-debugger-view-in-memory]+[2 of 3] Compiling Main             ( <TEMPORARY-DIRECTORY>/Main.hs, interpreted )[main]+(hdb) Heli+()+(hdb) Exiting...
+ test/golden/T83/T83.hdb-test view
@@ -0,0 +1,1 @@+$HDB Main.hs -v 0 < T83.hdb-stdin
+ test/golden/exceptions-multiple/exceptions-multiple.hdb-stdin view
@@ -0,0 +1,4 @@+break --exceptions+run+continue+exit
+ test/golden/exceptions-multiple/exceptions-multiple.hdb-stdout view
@@ -0,0 +1,23 @@+[1 of 3] Compiling GHC.Debugger.View.Class ( in-memory:GHC.Debugger.View.Class, interpreted )[haskell-debugger-view-in-memory]+[2 of 3] Compiling Main             ( <TEMPORARY-DIRECTORY>/prog/Main.hs, interpreted )[main]+(hdb) BreakFoundNoLoc {changed = True}+(hdb) About to throw first+Stopped at breakpoint+Exception: ErrorCall+Message: boom first+Call stack:+  HasCallStack backtrace:+    error, called at <TEMPORARY-DIRECTORY>/prog/Main.hs:8:10 in main:Main++Exception location: <TEMPORARY-DIRECTORY>/prog/Main.hs:8:10+(hdb) Handled first exception: boom first+Continuing after first exception+Stopped at breakpoint+Exception: ErrorCall+Message: boom second+Call stack:+  HasCallStack backtrace:+    error, called at <TEMPORARY-DIRECTORY>/prog/Main.hs:10:3 in main:Main++Exception location: <TEMPORARY-DIRECTORY>/prog/Main.hs:10:3+(hdb)
+ test/golden/exceptions-multiple/exceptions-multiple.hdb-test view
@@ -0,0 +1,3 @@+#!/bin/sh++$HDB prog/Main.hs < exceptions-multiple.hdb-stdin
+ test/golden/exceptions-multiple/prog/Main.hs view
@@ -0,0 +1,13 @@+module Main where++import Control.Exception++main :: IO ()+main = do+  putStrLn "About to throw first"+  catch (error "boom first") handler+  putStrLn "Continuing after first exception"+  error "boom second"++handler :: SomeException -> IO ()+handler se = putStrLn ("Handled first exception: " ++ displayException se)
+ test/golden/exceptions-uncaught/exceptions-uncaught.hdb-stdin view
@@ -0,0 +1,3 @@+break --error+run+exit
+ test/golden/exceptions-uncaught/exceptions-uncaught.hdb-stdout view
@@ -0,0 +1,22 @@+[1 of 3] Compiling GHC.Debugger.View.Class ( in-memory:GHC.Debugger.View.Class, interpreted )[haskell-debugger-view-in-memory]+[2 of 3] Compiling Main             ( <TEMPORARY-DIRECTORY>/prog/Main.hs, interpreted )[main]+(hdb) BreakFoundNoLoc {changed = True}+(hdb) About to throw+Handling exception: boom outer+Stopped at breakpoint+Exception: ErrorCall+Message: boom while handling+Call stack:+  While handling boom outer+  +  HasCallStack backtrace:+    error, called at <TEMPORARY-DIRECTORY>/prog/Main.hs:14:3 in main:Main+Inner exceptions:+  Exception: ErrorCall+  Message: boom outer+  Call stack:+    HasCallStack backtrace:+      error, called at <TEMPORARY-DIRECTORY>/prog/Main.hs:8:10 in main:Main++Exception location: <TEMPORARY-DIRECTORY>/prog/Main.hs:14:3+(hdb)
+ test/golden/exceptions-uncaught/exceptions-uncaught.hdb-test view
@@ -0,0 +1,3 @@+#!/bin/sh++$HDB prog/Main.hs < exceptions-uncaught.hdb-stdin
+ test/golden/exceptions-uncaught/prog/Main.hs view
@@ -0,0 +1,14 @@+module Main where++import Control.Exception++main :: IO ()+main = do+  putStrLn "About to throw"+  catch (error "boom outer") handler+  putStrLn "Should not reach here"++handler :: SomeException -> IO ()+handler se = do+  putStrLn ("Handling exception: " ++ displayException se)+  error "boom while handling"
+ test/golden/exceptions/exceptions.hdb-stdin view
@@ -0,0 +1,3 @@+break --exceptions+run+exit
+ test/golden/exceptions/exceptions.hdb-stdout view
@@ -0,0 +1,13 @@+[1 of 3] Compiling GHC.Debugger.View.Class ( in-memory:GHC.Debugger.View.Class, interpreted )[haskell-debugger-view-in-memory]+[2 of 3] Compiling Main             ( <TEMPORARY-DIRECTORY>/prog/Main.hs, interpreted )[main]+(hdb) BreakFoundNoLoc {changed = True}+(hdb) About to throw+Stopped at breakpoint+Exception: ErrorCall+Message: boom+Call stack:+  HasCallStack backtrace:+    error, called at <TEMPORARY-DIRECTORY>/prog/Main.hs:6:3 in main:Main++Exception location: <TEMPORARY-DIRECTORY>/prog/Main.hs:6:3+(hdb)
+ test/golden/exceptions/exceptions.hdb-test view
@@ -0,0 +1,3 @@+#!/bin/sh++$HDB prog/Main.hs < exceptions.hdb-stdin
+ test/golden/exceptions/prog/Main.hs view
@@ -0,0 +1,6 @@+module Main where++main :: IO ()+main = do+  putStrLn "About to throw"+  error "boom"
test/haskell/Main.hs view
@@ -44,8 +44,14 @@   let testsForInternal = Set.toList $ internalOnlySet `Set.union` defaultTestsSet   let testsForExternal = Set.toList $ externalOnlySet `Set.union` defaultTestsSet -  default_goldens   <- mapM (mkTest "") testsForExternal-  intinterp_goldens <- mapM (mkTest "--internal-interpreter") testsForInternal+  -- Disable IPE backtraces in tests to ensure consistent output between+  -- internal and external interpreter modes. When using the internal interpreter,+  -- IPE backtraces appear in debugger output but not with the external interpreter+  -- (since they run as separate processes). To use a single golden test file for+  -- both modes, we disable IPE backtraces by default in tests.+  let baseFlags = "--disable-ipe-backtraces"+  default_goldens   <- mapM (mkTest baseFlags) testsForExternal+  intinterp_goldens <- mapM (mkTest ("--internal-interpreter " ++ baseFlags)) testsForInternal    defaultMain $     testGroup "Tests"
test/haskell/Test/DAP/RunInTerminal.hs view
@@ -6,6 +6,9 @@ {-# LANGUAGE CPP #-} module Test.DAP.RunInTerminal (runInTerminalTests) where +import System.Exit+import Control.Exception+import Control.Monad import Control.Concurrent import DAP.Types import DAP.Utils@@ -30,7 +33,7 @@   testGroup "DAP.RunInTerminal"     [ #ifdef mingw32_HOST_OS-      ignoreTestBecause "Needs to be fixed for Windows" $+      ignoreTestBecause "Needs to be fixed for Windows (#199)" $ #endif       testGroup "runInTerminal: proxy forwards stdin correctly"         [ testCase "(default)" (runInTerminal1 "")@@ -52,10 +55,12 @@       <- P.createProcess (P.shell $ "hdb server " ++ flags ++ " --port " ++ show testPort)           {P.cwd = Just test_dir, P.std_out = P.CreatePipe, P.std_in = P.CreatePipe} +    serverOutputRef <- newIORef []+     -- 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+    forkIO $ flip catch (\(e :: IOException) -> print ("server process forwarding", e)) $ do       hSetBuffering hout LineBuffering       let loop = do             eof <- hIsEOF hout@@ -63,14 +68,18 @@               then return ()               else do                 _l <- hGetLine hout-                -- UNCOMMENT ME TO DEBUG-                -- putStrLn ("[server] " ++ _l)+                modifyIORef' serverOutputRef (_l :)                 loop       loop +    let flushServerOutput = do+          putStrLn "\n--- SERVER OUTPUT ---"+          readIORef serverOutputRef >>= mapM_ putStrLn . reverse+          putStrLn "---------------------\n"+     retryVar <- newIORef True     -- Connect to the DAP server-    withNewClient testPort retryVar $ \handle -> do+    flip onException flushServerOutput $ withNewClient testPort retryVar $ \handle -> do       -- As soon as we get a connection, stop retrying       writeIORef retryVar False @@ -112,12 +121,10 @@             ]         ] -      _ <- shouldReceive handle-            ["type" .= ("event" :: String), "event" .= ("output" :: String)]-      _ <- shouldReceive handle-            ["type" .= ("event" :: String), "event" .= ("output" :: String)]-      _ <- shouldReceive handle-            ["type" .= ("event" :: String), "event" .= ("output" :: String)]+      -- Receive output events+      forM_ [1..9] $ \_ ->+        shouldReceive handle+          ["type" .= ("event" :: String), "event" .= ("output" :: String)]       _ <- shouldReceive handle             [ "command" .= ("launch" :: String)             , "success" .= True]@@ -214,9 +221,9 @@       -- 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)+      assertBool ("Expected output to contain 'hello', got: " ++ show out_str)                  ("hello" `isInfixOf` out_str)-      assertBool ("Expected output to contain '" ++ secret_in ++ "' , got: " ++ out_str)+      assertBool ("Expected output to contain '" ++ secret_in ++ "' , got: " ++ show out_str)                  (secret_in `isInfixOf` out_str)        -- Send disconnect