diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,16 @@ # Revision history for haskell-debugger +## 0.6.0.0 -- 2025-09-10 + +* Improve unit handling and fix running when `main` functions exist across different units + * Add interactive home unit id + * The entry file determines which of the `main`s to run. +* Add proper option parsing +* Add preview version of `hdb cli` interactive mode, as an alternative to DAP server + * Experimental and incomplete +* Fix: output uncaught exceptions to stderr +* Fix: output eval completed result to console + ## 0.5.0.0 -- 2025-08-26 * Compatibility with GHC 9.14 diff --git a/haskell-debugger.cabal b/haskell-debugger.cabal --- a/haskell-debugger.cabal +++ b/haskell-debugger.cabal @@ -1,13 +1,13 @@ cabal-version: 3.12 name: haskell-debugger -version: 0.5.0.0 +version: 0.6.0.0 synopsis: A step-through machine-interface debugger for GHC Haskell description: The GHC debugger package provides a standalone executable called @hdb@ which can be used to step-through Haskell programs and can act as a Debug Adapter Protocol (DAP) - server in the @--server@ mode for debugging Haskell + server in the @server@ mode for debugging Haskell programs. . The Debug Adapter is implemented on top of the @@ -49,8 +49,9 @@ library import: warnings exposed-modules: GHC.Debugger, - GHC.Debugger.Evaluation, GHC.Debugger.Breakpoint, + GHC.Debugger.Evaluation, + GHC.Debugger.Logger, GHC.Debugger.Stopped, GHC.Debugger.Stopped.Variables, GHC.Debugger.Utils, @@ -79,7 +80,12 @@ 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.18, + -- Logger dependencies + time >= 1.14 && < 2, + prettyprinter >= 1.7.1 && < 2, + text >= 2.1 && < 2.3, + co-log-core >= 0.3.2.5 && < 0.4, hs-source-dirs: haskell-debugger default-language: Haskell2010 @@ -94,29 +100,32 @@ Development.Debug.Adapter.Evaluation, Development.Debug.Adapter.Init, Development.Debug.Adapter.Interface, - Development.Debug.Adapter.Logger, Development.Debug.Adapter.Output, Development.Debug.Adapter.Exit, Development.Debug.Adapter.Handles, - Development.Debug.Adapter + Development.Debug.Adapter, + Development.Debug.Interactive build-depends: base, ghc, exceptions, aeson, bytestring, containers, filepath, process, mtl, unix, - prettyprinter >= 1.7.1 && < 2, haskell-debugger, hie-bios, co-log-core >= 0.3.2.5 && < 0.4, implicit-hie ^>=0.1.4.0, transformers >= 0.6 && < 0.7, + -- Logger dependencies + prettyprinter, - time >= 1.15 && < 2, directory >= 1.3.9 && < 1.4, async >= 2.2.5 && < 2.3, text >= 2.1 && < 2.3, dap >= 0.2 && < 1, + + haskeline >= 0.8 && < 1, + optparse-applicative >= 0.18 && < 0.20 hs-source-dirs: hdb default-language: GHC2021 default-extensions: CPP diff --git a/haskell-debugger/GHC/Debugger.hs b/haskell-debugger/GHC/Debugger.hs --- a/haskell-debugger/GHC/Debugger.hs +++ b/haskell-debugger/GHC/Debugger.hs @@ -13,14 +13,15 @@ import GHC.Debugger.Monad import GHC.Debugger.Utils import GHC.Debugger.Interface.Messages +import GHC.Debugger.Logger -------------------------------------------------------------------------------- -- * Executing commands -------------------------------------------------------------------------------- -- | Execute the given debugger command in the current 'Debugger' session -execute :: Command -> Debugger Response -execute = \case +execute :: Recorder (WithSeverity DebuggerLog) -> Command -> Debugger Response +execute recorder = \case ClearFunctionBreakpoints -> DidClearBreakpoints <$ clearBreakpoints Nothing ClearModBreakpoints fp -> DidClearBreakpoints <$ clearBreakpoints (Just fp) SetBreakpoint bp -> DidSetBreakpoint <$> setBreakpoint bp BreakpointEnabled @@ -44,8 +45,14 @@ DoSingleStep -> DidStep <$> doSingleStep DoStepOut -> DidStep <$> doStepOut DoStepLocal -> DidStep <$> doLocalStep - DebugExecution { entryPoint, runArgs } -> DidExec <$> debugExecution entryPoint runArgs + DebugExecution { entryPoint, entryFile, runArgs } -> DidExec <$> debugExecution (cmapWithSev EvalLog recorder) entryFile entryPoint runArgs TerminateProcess -> liftIO $ do -- Terminate! exitWith ExitSuccess +data DebuggerLog + = EvalLog EvalLog + +instance Pretty DebuggerLog where + pretty = \ case + EvalLog msg -> pretty msg diff --git a/haskell-debugger/GHC/Debugger/Breakpoint.hs b/haskell-debugger/GHC/Debugger/Breakpoint.hs --- a/haskell-debugger/GHC/Debugger/Breakpoint.hs +++ b/haskell-debugger/GHC/Debugger/Breakpoint.hs @@ -21,6 +21,7 @@ import GHC.Utils.Outputable as GHC import GHC.Debugger.Monad +import GHC.Debugger.Session import GHC.Debugger.Utils import GHC.Debugger.Interface.Messages @@ -135,5 +136,5 @@ -- option is OFF and bp is ON (i.e. XOR) breakOn = bp_status /= BreakpointDisabled didChange = gopt opt dflags `xor` breakOn - GHC.setInteractiveDynFlags $ dflags `ch_opt` opt + setInteractiveDebuggerDynFlags $ dflags `ch_opt` opt return (BreakFoundNoLoc didChange) diff --git a/haskell-debugger/GHC/Debugger/Evaluation.hs b/haskell-debugger/GHC/Debugger/Evaluation.hs --- a/haskell-debugger/GHC/Debugger/Evaluation.hs +++ b/haskell-debugger/GHC/Debugger/Evaluation.hs @@ -1,19 +1,32 @@ -{-# LANGUAGE CPP, NamedFieldPuns, TupleSections, LambdaCase, - DuplicateRecordFields, RecordWildCards, TupleSections, ViewPatterns, - TypeApplications, ScopedTypeVariables, BangPatterns #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} module GHC.Debugger.Evaluation where import Control.Monad.IO.Class import Control.Monad.Catch +import qualified Data.List as List import Data.Maybe +import System.FilePath +import qualified Prettyprinter as Pretty import GHC import GHC.Builtin.Names (gHC_INTERNAL_GHCI_HELPERS) +import GHC.Unit.Types import GHC.Data.FastString import GHC.Driver.DynFlags as GHC +import GHC.Driver.Monad as GHC import GHC.Driver.Env as GHC -import GHC.Driver.Monad import GHC.Runtime.Debugger.Breakpoints as GHC +import qualified GHC.Unit.Module.ModSummary as GHC import GHC.ByteCode.Breakpoints import GHC.Types.Name.Occurrence (mkVarOccFS) import GHC.Types.Name.Reader as RdrName (mkOrig) @@ -25,20 +38,38 @@ import GHC.Debugger.Monad import GHC.Debugger.Utils import GHC.Debugger.Interface.Messages +import GHC.Debugger.Logger +data EvalLog + = LogEvalModule GHC.Module + +instance Pretty EvalLog where + pretty = \ case + LogEvalModule modl -> "Eval Module Context:" Pretty.<+> pretty (GHC.showSDocUnsafe (ppr modl)) + -------------------------------------------------------------------------------- -- * Evaluation -------------------------------------------------------------------------------- -- | Run a program with debugging enabled -debugExecution :: EntryPoint -> [String] {-^ Args -} -> Debugger EvalResult -debugExecution entry args = do +debugExecution :: Recorder (WithSeverity EvalLog) -> FilePath -> EntryPoint -> [String] {-^ Args -} -> Debugger EvalResult +debugExecution recorder entryFile entry args = do -- consider always using :trace like ghci-dap to always have a stacktrace? -- better solution could involve profiling stack traces or from IPE info? + modSummaryOfEntryFile <- findUnitIdOfEntryFile entryFile + let modOfEntryFile = GHC.ms_mod modSummaryOfEntryFile + unitIdOfEntryFile = GHC.ms_unitid modSummaryOfEntryFile - (entryExp, exOpts) <- case entry of + let + evalModule = mkModule (RealUnit (Definite unitIdOfEntryFile)) + (moduleName modOfEntryFile) + logWith recorder Info $ LogEvalModule evalModule + old_context <- GHC.getContext + GHC.setContext [GHC.IIModule evalModule] + + (entryExp, exOpts) <- case entry of MainEntry nm -> do let prog = fromMaybe "main" nm -- the wrapper is equivalent to GHCi's `:main arg1 arg2 arg3` @@ -53,11 +84,12 @@ -- be "\"some\"" "\"things\"". return (fn ++ " " ++ unwords args, GHC.execOptions) - GHC.execStmt entryExp exOpts >>= handleExecResult - + exec_res <- GHC.execStmt entryExp exOpts + GHC.setContext old_context -- restore context after running `main` + handleExecResult exec_res where -- It's not ideal to duplicate these two functions from ghci, but its unclear where they would better live. Perhaps next to compileParsedExprRemote? The issue is run - mkEvalWrapper :: GhcMonad m => String -> [String] -> m ForeignHValue + mkEvalWrapper :: GhcMonad m => String -> [String] -> m ForeignHValue mkEvalWrapper progname' args' = runInternal $ GHC.compileParsedExprRemote $ evalWrapper' `GHC.mkHsApp` nlHsString progname' @@ -82,6 +114,12 @@ `gopt_set` Opt_ImplicitImportQualified ) + findUnitIdOfEntryFile :: GhcMonad m => FilePath -> m GHC.ModSummary + findUnitIdOfEntryFile fp = do + modSums <- getAllLoadedModules + case List.find ((Just fp ==) . fmap normalise . GHC.ml_hs_file . GHC.ms_location ) modSums of + Nothing -> error $ "findUnitIdOfEntryFile: no unit id found for: " ++ fp + Just summary -> pure summary -- | Resume execution of the stopped debuggee program doContinue :: Debugger EvalResult diff --git a/haskell-debugger/GHC/Debugger/Interface/Messages.hs b/haskell-debugger/GHC/Debugger/Interface/Messages.hs --- a/haskell-debugger/GHC/Debugger/Interface/Messages.hs +++ b/haskell-debugger/GHC/Debugger/Interface/Messages.hs @@ -73,13 +73,13 @@ -- When the @'EntryPoint'@ is @'Main'@, @'runArgs'@ are set as process -- invocation arguments (as in @argv@) rather than passed directly as a -- Haskell function arguments. - | DebugExecution { entryPoint :: EntryPoint, runArgs :: [String] } + | DebugExecution { entryPoint :: EntryPoint, entryFile :: FilePath, runArgs :: [String] } -- | Terminate haskell-debugger and exit | TerminateProcess -- | An entry point for program execution. -data EntryPoint = MainEntry { mainName :: Maybe String } | FunctionEntry { fnName :: String } +data EntryPoint = MainEntry { mainName :: Maybe String } | FunctionEntry { fnName :: String } deriving (Show, Generic) -- | A breakpoint can be set/removed on functions by name, or in modules by diff --git a/haskell-debugger/GHC/Debugger/Logger.hs b/haskell-debugger/GHC/Debugger/Logger.hs new file mode 100644 --- /dev/null +++ b/haskell-debugger/GHC/Debugger/Logger.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RankNTypes #-} + +-- | Simple Logger API using co-log style loggers +module GHC.Debugger.Logger ( + -- * The core Logger type + Recorder, + logWith, + -- * Log messages + Pretty(..), + -- * For simpler usage + Colog.LogAction (..), + toCologAction, + fromCologAction, + -- * Severity + Severity (..), + WithSeverity (..), + cmap, + cmapIO, + cmapWithSev, + + -- * Pretty printing of logs + renderPrettyWithSeverity, + renderWithSeverity, + renderPretty, + renderSeverity, + renderWithTimestamp, + + -- Re-exports + module Data.Functor.Contravariant, +) where + +import GHC.Stack + +import Control.Monad.IO.Class +import Control.Monad ((>=>)) + +import Colog.Core (Severity(..), WithSeverity(..)) +import qualified Colog.Core as Colog +import Data.Functor.Contravariant (Contravariant (contramap)) +import Data.Text (Text) +import qualified Data.Text as T +import Prettyprinter +import Prettyprinter.Render.Text (renderStrict) +import Data.Time (defaultTimeLocale, formatTime, getCurrentTime) + +newtype Recorder msg = Recorder + { logger_ :: forall m. (MonadIO m) => msg -> m () } + +instance Contravariant Recorder where + contramap f Recorder{ logger_ } = + Recorder + { logger_ = logger_ . f } + +instance Semigroup (Recorder msg) where + (<>) Recorder{ logger_ = logger_1 } Recorder{ logger_ = logger_2 } = + Recorder + { logger_ = \msg -> logger_1 msg >> logger_2 msg } + +instance Monoid (Recorder msg) where + mempty = + Recorder + { logger_ = \_ -> pure () } + +logWith :: (HasCallStack, MonadIO m) => Recorder (WithSeverity msg) -> Severity -> msg -> m () +logWith (Recorder logger_) sev msg = logger_ $ WithSeverity msg sev + +cmap :: (a -> b) -> Recorder b -> Recorder a +cmap = contramap + +cmapWithSev :: (a -> b) -> Recorder (WithSeverity b) -> Recorder (WithSeverity a) +cmapWithSev f = contramap (fmap f) + +cmapIO :: (a -> IO b) -> Recorder b -> Recorder a +cmapIO f Recorder{ logger_ } = + Recorder + { logger_ = (liftIO . f) >=> logger_ } + +renderPrettyWithSeverity :: Pretty a => WithSeverity a -> Text +renderPrettyWithSeverity = + renderWithSeverity renderPretty + +renderWithSeverity :: (a -> Text) -> WithSeverity a -> Text +renderWithSeverity f msgWithSev = + renderSeverity (getSeverity msgWithSev) <> " " <> f (getMsg msgWithSev) + +renderPretty :: Pretty a => a -> Text +renderPretty a = + let + docToText = renderStrict . layoutPretty defaultLayoutOptions + in + docToText (pretty a) + +renderWithTimestamp :: Text -> IO Text +renderWithTimestamp msg = do + t <- getCurrentTime + let timeStamp = utcTimeToText t + pure $ "[" <> timeStamp <> "]" <> msg + where + utcTimeToText utcTime = T.pack $ formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%6QZ" utcTime + +renderSeverity :: Severity -> Text +renderSeverity = \ case + Debug -> "[DEBUG]" + Info -> "[INFO]" + Warning -> "[WARNING]" + Error -> "[ERROR]" + +toCologAction :: (MonadIO m, HasCallStack) => Recorder msg -> Colog.LogAction m msg +toCologAction (Recorder logger_) = Colog.LogAction $ \msg -> do + logger_ msg + +fromCologAction :: (HasCallStack) => Colog.LogAction IO msg -> Recorder msg +fromCologAction (Colog.LogAction logger_) = Recorder $ \msg -> do + liftIO $ logger_ msg diff --git a/haskell-debugger/GHC/Debugger/Session.hs b/haskell-debugger/GHC/Debugger/Session.hs --- a/haskell-debugger/GHC/Debugger/Session.hs +++ b/haskell-debugger/GHC/Debugger/Session.hs @@ -12,6 +12,10 @@ toGhcTarget, CacheDirs(..), getCacheDirs, + -- * Debugger's Interactive Home Unit + interactiveGhcDebuggerUnitId, + getInteractiveDebuggerDynFlags, + setInteractiveDebuggerDynFlags, -- * DynFlags modifications setWorkingDirectory, setCacheDirs, @@ -114,8 +118,9 @@ GHC.setTargets (fmap toGhcTarget targetDetails) -- | Set up the 'HomeUnitGraph' with empty 'HomeUnitEnv's. -createUnitEnvFromFlags :: NonEmpty.NonEmpty DynFlags -> IO HomeUnitGraph -createUnitEnvFromFlags unitDflags = do +-- The first 'DynFlags' are the 'DynFlags' for the interactive session. +createUnitEnvFromFlags :: DynFlags -> [DynFlags] -> IO HomeUnitGraph +createUnitEnvFromFlags initialDynFlags unitDflags = do let newInternalUnitEnv dflags hpt = mkHomeUnitEnv State.emptyUnitState Nothing dflags hpt Nothing @@ -123,8 +128,23 @@ emptyHpt <- emptyHomePackageTable pure (homeUnitId_ dflags, newInternalUnitEnv dflags emptyHpt)) unitDflags - pure $ unitEnv_new (Map.fromList (NonEmpty.toList unitEnvList)) + interactiveHomeUnit <- do + let interactiveDynFlags = initialDynFlags + { homeUnitId_ = interactiveGhcDebuggerUnitId + , importPaths = [] + , packageFlags = + [ ExposePackage + ("-package-id " ++ unitIdString unitId) + (UnitIdArg $ RealUnit (Definite unitId)) + (ModRenaming True []) + | (unitId, _) <- unitEnvList + ] + } + emptyHpt <- emptyHomePackageTable + pure (homeUnitId_ interactiveDynFlags, newInternalUnitEnv interactiveDynFlags emptyHpt) + pure $ unitEnv_new (Map.fromList (interactiveHomeUnit : unitEnvList)) + -- | Given a set of 'DynFlags', set up the 'UnitEnv' and 'HomeUnitEnv' for this -- 'HscEnv'. -- We assume the 'HscEnv' is "empty", e.g. wasn't already used to compile @@ -133,7 +153,7 @@ initHomeUnitEnv unitDflags env = do let dflags0 = hsc_dflags env -- additionally, set checked dflags so we don't lose fixes - initial_home_graph <- createUnitEnvFromFlags (dflags0 NonEmpty.:| unitDflags) + initial_home_graph <- createUnitEnvFromFlags dflags0 unitDflags let home_units = unitEnv_keys initial_home_graph home_unit_graph <- forM initial_home_graph $ \homeUnitEnv -> do let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv @@ -151,12 +171,12 @@ , homeUnitEnv_home_unit = Just home_unit } - let dflags1 = homeUnitEnv_dflags $ unitEnv_lookup (homeUnitId_ dflags0) home_unit_graph + let dflags1 = homeUnitEnv_dflags $ unitEnv_lookup interactiveGhcDebuggerUnitId home_unit_graph let unit_env = UnitEnv { ue_platform = targetPlatform dflags1 , ue_namever = GHC.ghcNameVersion dflags1 , ue_home_unit_graph = home_unit_graph - , ue_current_unit = homeUnitId_ dflags0 + , ue_current_unit = interactiveGhcDebuggerUnitId , ue_module_graph = ue_module_graph (hsc_unit_env env) , ue_eps = ue_eps (hsc_unit_env env) } @@ -273,6 +293,53 @@ -- Create a unique folder per set of different GHC options, assuming that each different set of -- GHC options will create incompatible interface files. opts_hash = B.unpack $ B16.encode $ H.finalize $ H.updates H.init (map B.pack opts) + +-- ---------------------------------------------------------------------------- +-- The Interactive DynFlags +-- ---------------------------------------------------------------------------- + +interactiveGhcDebuggerUnit :: Unit +interactiveGhcDebuggerUnit = stringToUnit "interactiveGhcDebugger" + +interactiveGhcDebuggerUnitId :: UnitId +interactiveGhcDebuggerUnitId = toUnitId interactiveGhcDebuggerUnit + +getInteractiveDebuggerDynFlags :: GhcMonad m => m DynFlags +getInteractiveDebuggerDynFlags = do + env <- getSession + pure $ ue_unitFlags interactiveGhcDebuggerUnitId (hsc_unit_env env) + +-- | Set the interactive 'DynFlags' for the haskell-debugger session. +-- We manage a separate home unit for the interactive 'DynFlags'. +-- The invariant is that 'DynFlags' found in 'InteractiveContext' *must* be +-- the same 'DynFlags' as the ones found in 'interactiveGhcDebuggerUnitId' in +-- the 'HomeUnitEnv' +-- This function upholds this invariant. +-- +-- Always prefer this, over 'setInteractiveDynFlags'. +setInteractiveDebuggerDynFlags :: GhcMonad m => DynFlags -> m () +setInteractiveDebuggerDynFlags dflags = do + env <- getSession + norm_dflags <- GHC.normaliseInteractiveDynFlags (hsc_logger env) dflags + env' <- GHC.initialiseInteractiveDynFlags norm_dflags env + -- Make sure the 'InteractiveContext' and 'interactiveGhcDebuggerUnitId' have exactly + -- the same 'DynFlags' + let newEnv = + if homeUnitId_ (hsc_dflags env') == interactiveGhcDebuggerUnitId + then hscSetFlags norm_dflags env' + else + let + unit_env = hsc_unit_env env' + in env' + { hsc_unit_env = unit_env + { ue_home_unit_graph = + updateUnitFlags + interactiveGhcDebuggerUnitId + (const norm_dflags) + (ue_home_unit_graph unit_env) + } + } + setSession newEnv -- ---------------------------------------------------------------------------- -- Modification of DynFlags diff --git a/hdb/Development/Debug/Adapter.hs b/hdb/Development/Debug/Adapter.hs --- a/hdb/Development/Debug/Adapter.hs +++ b/hdb/Development/Debug/Adapter.hs @@ -29,6 +29,7 @@ #else , breakpointMap :: Map.Map GHC.BreakpointId BreakpointSet #endif + , entryFile :: FilePath , entryPoint :: String , entryArgs :: [String] , projectRoot :: FilePath diff --git a/hdb/Development/Debug/Adapter/Evaluation.hs b/hdb/Development/Debug/Adapter/Evaluation.hs --- a/hdb/Development/Debug/Adapter/Evaluation.hs +++ b/hdb/Development/Debug/Adapter/Evaluation.hs @@ -22,11 +22,11 @@ -- [ ] Consider using Output events for debuggee evaluation. startExecution :: DebugAdaptor EvalResult startExecution = do - DAS{entryPoint, entryArgs} <- getDebugSession + DAS{entryFile, entryPoint, entryArgs} <- getDebugSession let entry | entryPoint == "main" = MainEntry Nothing | otherwise = FunctionEntry entryPoint - DidExec er <- sendSync DebugExecution{entryPoint = entry, runArgs = entryArgs} + DidExec er <- sendSync DebugExecution{entryPoint = entry, entryFile, runArgs = entryArgs} return er -------------------------------------------------------------------------------- @@ -76,10 +76,13 @@ Output.console (T.pack e) sendTerminatedEvent defaultTerminatedEvent sendExitedEvent (ExitedEvent 43) - EvalCompleted{} -> do + EvalCompleted{resultVal, resultType} -> do + Output.console (T.pack $ "Evaluation returned: " ++ resultVal ++ " :: " ++ resultType) sendTerminatedEvent defaultTerminatedEvent sendExitedEvent (ExitedEvent 0) - EvalException{} -> do + EvalException{resultVal, resultType} -> do + Output.stderr (T.pack $ "Uncaught exception of type " ++ resultType ++ " was thrown!") + Output.stderr (T.pack resultVal) sendTerminatedEvent defaultTerminatedEvent sendExitedEvent (ExitedEvent 42) EvalStopped {breakId = Nothing} -> diff --git a/hdb/Development/Debug/Adapter/Flags.hs b/hdb/Development/Debug/Adapter/Flags.hs --- a/hdb/Development/Debug/Adapter/Flags.hs +++ b/hdb/Development/Debug/Adapter/Flags.hs @@ -21,6 +21,7 @@ import System.FilePath import System.IO.Error import Text.ParserCombinators.ReadP (readP_to_S) +import Prettyprinter import qualified HIE.Bios as HIE import qualified HIE.Bios.Config as Config @@ -31,8 +32,17 @@ import qualified Hie.Locate as Implicit import qualified Hie.Yaml as Implicit -import Development.Debug.Adapter.Logger +import GHC.Debugger.Logger +data FlagsLog + = HieBiosLog HIE.Log + | LogCradle (HIE.Cradle Void) + +instance Pretty FlagsLog where + pretty = \ case + HieBiosLog msg -> pretty msg + LogCradle crdl -> "Determined Cradle:" <+> viaShow crdl + -- | Flags inferred by @hie-bios@ to invoke GHC data HieBiosFlags = HieBiosFlags { ghcInvocation :: [String] @@ -46,18 +56,21 @@ -- root of the cradle, but in some sub-directory. } -hieBiosCradle :: LogAction IO (WithSeverity HIE.Log) {-^ Logger -} +hieBiosCradle :: Recorder (WithSeverity FlagsLog) {-^ Logger -} -> FilePath {-^ Project root -} -> FilePath {-^ Entry file relative to root -} -> IO (Either String (HIE.Cradle Void)) hieBiosCradle logger root relTarget = runExceptT $ do let target = root relTarget explicitCradle <- HIE.findCradle target & liftIO - cradle <- maybe (loadImplicitCradle logger target) - (HIE.loadCradle logger) explicitCradle & liftIO + cradle <- maybe (loadImplicitCradle hieBiosLogger target) + (HIE.loadCradle hieBiosLogger) explicitCradle & liftIO + logWith logger Info $ LogCradle cradle pure cradle + where + hieBiosLogger = toCologAction $ cmapWithSev HieBiosLog logger -hieBiosRuntimeGhcVersion :: LogAction IO (WithSeverity HIE.Log) +hieBiosRuntimeGhcVersion :: Recorder (WithSeverity FlagsLog) -> HIE.Cradle Void -> IO (Either String Version) hieBiosRuntimeGhcVersion _logger cradle = runExceptT $ do @@ -67,7 +80,7 @@ Just ver -> pure ver -- | Make 'HieBiosFlags' from the given target file -hieBiosFlags :: LogAction IO (WithSeverity HIE.Log) {-^ Logger -} +hieBiosFlags :: Recorder (WithSeverity FlagsLog) {-^ Logger -} -> HIE.Cradle Void {-^ Project cradle the entry file belongs to -} -> FilePath {-^ Project root -} -> FilePath {-^ Entry file relative to root -} diff --git a/hdb/Development/Debug/Adapter/Init.hs b/hdb/Development/Debug/Adapter/Init.hs --- a/hdb/Development/Debug/Adapter/Init.hs +++ b/hdb/Development/Debug/Adapter/Init.hs @@ -24,11 +24,12 @@ import Data.Aeson as Aeson import GHC.Generics import System.Directory +import System.FilePath import Development.Debug.Adapter import Development.Debug.Adapter.Exit import Development.Debug.Adapter.Flags -import Development.Debug.Adapter.Logger +import GHC.Debugger.Logger import qualified Development.Debug.Adapter.Output as Output import qualified GHC.Debugger as Debugger @@ -40,6 +41,19 @@ import Development.Debug.Adapter.Handles -------------------------------------------------------------------------------- +-- * Logging +-------------------------------------------------------------------------------- + +data InitLog + = DebuggerLog Debugger.DebuggerLog + | FlagsLog FlagsLog + +instance Pretty InitLog where + pretty = \ case + DebuggerLog msg -> pretty msg + FlagsLog msg -> pretty msg + +-------------------------------------------------------------------------------- -- * Client -------------------------------------------------------------------------------- @@ -69,11 +83,11 @@ -- | Initialize debugger -- -- Returns @True@ if successful. -initDebugger :: LogAction IO (WithSeverity T.Text) -> LaunchArgs -> DebugAdaptor Bool -initDebugger l LaunchArgs{__sessionId, projectRoot, entryFile, entryPoint, entryArgs, extraGhcArgs} = do +initDebugger :: Recorder (WithSeverity InitLog) -> LaunchArgs -> DebugAdaptor Bool +initDebugger l LaunchArgs{__sessionId, projectRoot, entryFile = entryFile, entryPoint, entryArgs, extraGhcArgs} = do syncRequests <- liftIO newEmptyMVar syncResponses <- liftIO newEmptyMVar - let hieBiosLogger = cmapWithSev renderPretty l + let hieBiosLogger = cmapWithSev FlagsLog l cradle <- liftIO (hieBiosCradle hieBiosLogger projectRoot entryFile) >>= \ case Left e -> @@ -123,8 +137,9 @@ finished_init <- liftIO $ newEmptyMVar - registerNewDebugSession (maybe "debug-session" T.pack __sessionId) DAS{..} - [ debuggerThread finished_init writeDebuggerOutput projectRoot flags extraGhcArgs entryFile defaultRunConf syncRequests syncResponses + let absEntryFile = normalise $ projectRoot entryFile + registerNewDebugSession (maybe "debug-session" T.pack __sessionId) DAS{entryFile=absEntryFile,..} + [ debuggerThread l finished_init writeDebuggerOutput projectRoot flags extraGhcArgs absEntryFile defaultRunConf syncRequests syncResponses , handleDebuggerOutput readDebuggerOutput , stdoutCaptureThread , stderrCaptureThread @@ -177,7 +192,8 @@ -- This sets the global CWD for this process, disallowing multiple sessions -- at the same, but that's OK because we currently only support -- single-session mode. Each new session gets a new debugger process. -debuggerThread :: MVar (Either String ()) -- ^ To signal when initialization is complete. +debuggerThread :: Recorder (WithSeverity InitLog) + -> MVar (Either String ()) -- ^ To signal when initialization is complete. -> Handle -- ^ The write end of a handle for debug compiler output -> FilePath -- ^ Working directory for GHC session -> HieBiosFlags -- ^ GHC Invocation flags @@ -189,7 +205,7 @@ -> (DebugAdaptorCont () -> IO ()) -- ^ Allows unlifting DebugAdaptor actions to IO. See 'registerNewDebugSession'. -> IO () -debuggerThread finished_init writeDebuggerOutput workDir HieBiosFlags{..} extraGhcArgs mainFp runConf requests replies withAdaptor = do +debuggerThread recorder finished_init writeDebuggerOutput workDir HieBiosFlags{..} extraGhcArgs mainFp runConf requests replies withAdaptor = do let finalGhcInvocation = ghcInvocation ++ extraGhcArgs @@ -210,7 +226,7 @@ forever $ do req <- takeMVar requests & liftIO - resp <- (Debugger.execute req <&> Right) + resp <- (Debugger.execute (cmapWithSev DebuggerLog recorder) req <&> Right) `catch` \(e :: SomeException) -> pure (Left (displayExceptionWithContext e)) either bad reply resp diff --git a/hdb/Development/Debug/Adapter/Logger.hs b/hdb/Development/Debug/Adapter/Logger.hs deleted file mode 100644 --- a/hdb/Development/Debug/Adapter/Logger.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} - --- | Simple Logger API using co-log style loggers -module Development.Debug.Adapter.Logger ( - LogAction (..), - Severity (..), - WithSeverity (..), - cmap, - cmapIO, - cmapWithSev, - - -- * Pretty printing of logs - renderPrettyWithSeverity, - renderWithSeverity, - renderPretty, - renderSeverity, - renderWithTimestamp, -) where - -import Control.Monad.IO.Class -import Control.Monad ((>=>)) -import Colog.Core (LogAction (..), Severity (..), WithSeverity (..)) -import Colog.Core.Action (cmap) -import Data.Text (Text) -import qualified Data.Text as T -import Prettyprinter -import Prettyprinter.Render.Text (renderStrict) -import Data.Time (defaultTimeLocale, formatTime, getCurrentTime) - -cmapWithSev :: (a -> b) -> LogAction m (WithSeverity b) -> LogAction m (WithSeverity a) -cmapWithSev f = cmap (fmap f) - -cmapIO :: MonadIO m => (a -> IO b) -> LogAction m b -> LogAction m a -cmapIO f LogAction{ unLogAction } = - LogAction - { unLogAction = (liftIO . f) >=> unLogAction } - -renderPrettyWithSeverity :: Pretty a => WithSeverity a -> Text -renderPrettyWithSeverity = - renderWithSeverity renderPretty - -renderWithSeverity :: (a -> Text) -> WithSeverity a -> Text -renderWithSeverity f msgWithSev = - renderSeverity (getSeverity msgWithSev) <> " " <> f (getMsg msgWithSev) - -renderPretty :: Pretty a => a -> Text -renderPretty a = - let - docToText = renderStrict . layoutPretty defaultLayoutOptions - in - docToText (pretty a) - -renderWithTimestamp :: Text -> IO Text -renderWithTimestamp msg = do - t <- getCurrentTime - let timeStamp = utcTimeToText t - pure $ "[" <> timeStamp <> "]" <> msg - where - utcTimeToText utcTime = T.pack $ formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%6QZ" utcTime - -renderSeverity :: Severity -> Text -renderSeverity = \ case - Debug -> "[DEBUG]" - Info -> "[INFO]" - Warning -> "[WARNING]" - Error -> "[ERROR]" diff --git a/hdb/Development/Debug/Interactive.hs b/hdb/Development/Debug/Interactive.hs new file mode 100644 --- /dev/null +++ b/hdb/Development/Debug/Interactive.hs @@ -0,0 +1,250 @@ +{-# LANGUAGE LambdaCase, ViewPatterns, RecordWildCards #-} +module Development.Debug.Interactive where + +import System.IO +import System.Exit +import System.Directory +import System.Console.Haskeline +import System.Console.Haskeline.Completion +import Control.Monad.State +import Control.Monad.Reader +import Control.Monad.RWS +import Options.Applicative +import Options.Applicative.BashCompletion + +import Development.Debug.Adapter.Flags -- use different namespace for common things +import Development.Debug.Adapter.Handles + +import GHC.Debugger.Logger +import GHC.Debugger.Interface.Messages +import GHC.Debugger.Monad +import GHC.Debugger + +-- | Interactive debugging monad +type InteractiveDM a = InputT (RWST (FilePath{-entry file-},String{-entry point-}, [String]{-run args-}) () + (Maybe Command{-last cmd-}) Debugger) a + +data InteractiveLog + = DebuggerLog DebuggerLog + | FlagsLog FlagsLog + +instance Pretty InteractiveLog where + pretty = \ case + DebuggerLog msg -> pretty msg + FlagsLog msg -> pretty msg + +-- | Run it +runIDM :: String -- ^ entryPoint + -> FilePath -- ^ entryFile + -> [String] -- ^ entryArgs + -> [String] -- ^ extraGhcArgs + -> InteractiveDM a + -> IO a +runIDM entryPoint entryFile entryArgs extraGhcArgs act = do + projectRoot <- getCurrentDirectory + l <- handleLogger stdout + let + loggerWithSev = cmap renderPrettyWithSeverity (fromCologAction l) + let hieBiosLogger = cmapWithSev FlagsLog loggerWithSev + cradle <- hieBiosCradle hieBiosLogger projectRoot entryFile >>= + \case + Left e -> exitWithMsg e + Right c -> pure c + mflags <- hieBiosFlags hieBiosLogger cradle projectRoot entryFile + case mflags of + Left e -> exitWithMsg e + Right HieBiosFlags{..} -> do + let defaultRunConf = RunDebuggerSettings + { supportsANSIStyling = True + , supportsANSIHyperlinks = False + } + let finalGhcInvocation = ghcInvocation ++ extraGhcArgs + runDebugger stdout rootDir componentDir libdir units finalGhcInvocation entryFile defaultRunConf $ + fmap fst $ + evalRWST (runInputT (setComplete noCompletion defaultSettings) act) + (entryFile, entryPoint, entryArgs) Nothing + where + exitWithMsg str = do + putStrLn str + exitWith (ExitFailure 33) + + -- completeF = completeWordWithPrev Nothing filenameWordBreakChars $ + -- \(reverse -> previous) word -> do + -- let comp_words = words previous ++ [word] + -- comp_cword = length comp_words + -- case execParserPure parserPrefs cmdParserInfo + -- ("--bash-completion-index":show comp_cword: + -- concat (zipWith (\fl a -> [fl, show a]) (repeat "--bash-completion-word") comp_words)) of + -- CompletionInvoked CompletionResult{execCompletion} -> + -- map simpleCompletion . words <$> liftIO (execCompletion "") + -- _ -> return [] + +-- | Run the interactive command-line debugger +debugInteractive :: Recorder (WithSeverity InteractiveLog) -> InteractiveDM () +debugInteractive recorder = withInterrupt loop + where + debugRec = cmapWithSev DebuggerLog recorder + loop = handleInterrupt loop $ do + minput <- getInputLine "(hdb) " + case minput of + Nothing -> outputStrLn "Exiting..." >> liftIO (exitWith ExitSuccess) + Just "" -> do + lift get >>= \case + Nothing -> return () + Just (cmd :: Command) -> do + out <- lift . lift $ execute debugRec cmd -- repeat last command + printResponse debugRec out + Just input -> do + mcmd <- parseCmd input + lift $ put mcmd + case mcmd of + Nothing -> return () + Just cmd -> do + out <- lift . lift $ execute debugRec cmd + printResponse debugRec out + loop + +-------------------------------------------------------------------------------- +-- Printing +-------------------------------------------------------------------------------- + +printResponse :: Recorder (WithSeverity DebuggerLog) -> Response -> InteractiveDM () +printResponse recd = \case + DidEval er -> outputStrLn $ show er + DidSetBreakpoint bf -> outputStrLn $ show bf + DidRemoveBreakpoint bf -> outputStrLn $ show bf + DidGetBreakpoints mb_span -> outputStrLn $ show mb_span + DidClearBreakpoints -> outputStrLn "Cleared all breakpoints." + DidContinue er -> outputStrLn $ show er + DidStep er -> printEvalResult recd er + DidExec er -> outputStrLn $ show er + GotStacktrace stackframes -> outputStrLn $ show stackframes + GotScopes scopeinfos -> outputStrLn $ show scopeinfos + GotVariables vis -> outputStrLn $ show vis -- (Either VarInfo [VarInfo]) + Aborted str -> outputStrLn ("Aborted: " ++ str) + Initialised -> pure () + +printEvalResult :: Recorder (WithSeverity DebuggerLog) -> EvalResult -> InteractiveDM () +printEvalResult recd EvalStopped{breakId} = do + out <- lift . lift $ execute recd GetScopes + printResponse recd out +printEvalResult _ er = outputStrLn $ show er + +-------------------------------------------------------------------------------- +-- Command parser +-------------------------------------------------------------------------------- + +breakpointParser :: Parser Breakpoint +breakpointParser = + ( ModuleBreak + <$> argument str + ( metavar "PATH" -- todo: accept module breaks using module name + <> help "Path to module to break at" ) + <*> argument auto + ( metavar "LINE_NUM" + <> help "The line number to break at" ) + <*> optional (argument auto + ( metavar "COLUMN_NUM" + <> help "The column number to break at" )) + ) + <|> + ( FunctionBreak + <$> option str + ( long "name" + <> short 'n' + <> metavar "FUNCTION_NAME" + <> help "Set a breakpoint using the function name" ) + ) + <|> + ( flag' OnExceptionsBreak ( long "exceptions" ) + ) + <|> + ( flag' OnUncaughtExceptionsBreak ( long "error" ) + ) + +runParser :: FilePath -> String -> [String] -> Parser Command +runParser entryFile entryPoint entryArgs = + -- --entry with some args + -- (DebugExecution <$> parseEntry <*> parseSomeArgs) + -- --entry without any args + -- <|> (DebugExecution <$> parseEntry <*> pure []) + -- just some args + (DebugExecution (mkEntry entryPoint) entryFile <$> parseSomeArgs) + -- just "run" + <|> (pure $ DebugExecution (mkEntry entryPoint) entryFile entryArgs) + where + parseEntry = + fmap mkEntry $ + option str + ( long "entry" + <> short 'e' + <> metavar "FUNCTION_NAME" + <> help "Run with this entry point" + ) + parseSomeArgs = + some ( argument str + ( metavar "ARGS" <> help "Arguments to pass to the entry point. If empty, the arguments given at the debugger invocation are used." ) ) + mkEntry entry + | entry == "main" = MainEntry Nothing + | otherwise = FunctionEntry entryPoint + +-- | Combined parser for 'Command' +cmdParser :: FilePath -> String -> [String] -> Parser Command +cmdParser entryFile entryPoint entryArgs = hsubparser + ( Options.Applicative.command "break" + ( info (SetBreakpoint <$> breakpointParser) + ( progDesc "Set a breakpoint" ) ) + <> + Options.Applicative.command "delete" + ( info (DelBreakpoint <$> breakpointParser) + ( progDesc "Delete a breakpoint" ) ) + <> + Options.Applicative.command "run" + ( info (runParser entryFile entryPoint entryArgs) + ( progDesc "Run the debuggee" ) ) + <> + Options.Applicative.command "next" + ( info (pure DoStepLocal) + ( progDesc "Step over to the next line" ) ) + <> + Options.Applicative.command "step" + ( info (pure DoSingleStep) + ( progDesc "Step-in to the next immediate location" ) ) + <> + Options.Applicative.command "finish" + ( info (pure DoStepOut) + ( progDesc "Step-out of the current function into the caller/its continuation" ) ) + <> + Options.Applicative.command "continue" + ( info (pure DoContinue) + ( progDesc "Continue executing from the current breakpoint" ) ) + <> + Options.Applicative.command "print" + ( info (DoEval . unwords <$> many (argument str ( metavar "EXPRESSION" + <> help "Expression to evaluate in the current context" ))) + ( progDesc "Evaluate an expression in the current context" ) ) + ) + +-- | Main parser info +cmdParserInfo :: FilePath -> String -> [String] -> ParserInfo Command +cmdParserInfo entryFile entryPoint entryArgs = info (cmdParser entryFile entryPoint entryArgs) + ( fullDesc ) + +-- | Parse command line arguments +parseCmd :: String -> InteractiveDM (Maybe Command) +parseCmd input = do + (entryFile, entryPoint, entryArgs) <- lift ask + let + res = execParserPure + parserPrefs + (cmdParserInfo entryFile entryPoint entryArgs) + (words input) + in case res of + Success x -> + return (Just x) + Failure bad -> + let (msg, _exit) = renderFailure bad "(hdb)" + in outputStrLn msg >> pure Nothing + _ -> outputStrLn "Unsupported command parsing mode" >> pure Nothing + +parserPrefs = prefs (disambiguate <> showHelpOnError <> showHelpOnEmpty) diff --git a/hdb/Main.hs b/hdb/Main.hs --- a/hdb/Main.hs +++ b/hdb/Main.hs @@ -14,33 +14,126 @@ import Development.Debug.Adapter.Evaluation import Development.Debug.Adapter.Exit import Development.Debug.Adapter.Handles -import Development.Debug.Adapter.Logger +import GHC.Debugger.Logger import Development.Debug.Adapter +import Development.Debug.Interactive + import System.IO (hSetBuffering, BufferMode(LineBuffering)) -import DAP.Log +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 +-- | The options `hdb` is invoked in the command line with +data HdbOptions + -- | @server --port @ + = HdbDAPServer + { port :: Int + } + -- | @[--entry-point=] [--extra-ghc-args=""] [] -- []@ + | HdbCLI + { entryPoint :: String + , entryFile :: FilePath + , entryArgs :: [String] + , extraGhcArgs :: [String] + } + +-------------------------------------------------------------------------------- +-- Options parser +-------------------------------------------------------------------------------- + +-- | Parser for HdbDAPServer options +serverParser :: Parser HdbOptions +serverParser = HdbDAPServer + <$> option auto + ( long "port" + <> short 'p' + <> metavar "PORT" + <> help "DAP server port" ) + +-- | 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" ) + +-- | 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 + +-- | Main parser info +hdbParserInfo :: ParserInfo HdbOptions +hdbParserInfo = info (hdbOptionsParser <**> 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 + +-------------------------------------------------------------------------------- + defaultStdoutForwardingAction :: T.Text -> IO () defaultStdoutForwardingAction line = do T.hPutStrLn stderr ("[INTERCEPTED STDOUT] " <> line) main :: IO () main = do - port <- getArgs >>= \case - ["--server", "--port", readMaybe -> Just p] -> return p - _ -> fail "usage: --server --port " - config <- getConfig port - withInterceptedStdoutForwarding defaultStdoutForwardingAction $ \realStdout -> do - hSetBuffering realStdout LineBuffering - l <- handleLogger realStdout - let - timeStampLogger = cmapIO renderWithTimestamp l - loggerWithSev = cmap (renderWithSeverity id) timeStampLogger - runDAPServerWithLogger (cmap renderDAPLog timeStampLogger) config (talk loggerWithSev) + hdbOpts <- parseHdbOptions + case hdbOpts of + HdbDAPServer{port} -> do + config <- getConfig port + withInterceptedStdoutForwarding defaultStdoutForwardingAction $ \realStdout -> do + hSetBuffering realStdout LineBuffering + l <- handleLogger realStdout + let + timeStampLogger :: Recorder T.Text + timeStampLogger = cmapIO renderWithTimestamp (fromCologAction l) + loggerWithSev :: Recorder (WithSeverity MainLog) + loggerWithSev = cmap renderPrettyWithSeverity timeStampLogger + runDAPServerWithLogger (toCologAction $ cmap DAP.renderDAPLog timeStampLogger) config (talk loggerWithSev) + HdbCLI{..} -> do + l <- handleLogger stdout + let + timeStampLogger :: Recorder T.Text + timeStampLogger = cmapIO renderWithTimestamp (fromCologAction l) + loggerWithSev :: Recorder (WithSeverity MainLog) + loggerWithSev = cmap renderPrettyWithSeverity timeStampLogger + runIDM entryPoint entryFile entryArgs extraGhcArgs $ + debugInteractive (cmapWithSev InteractiveLog loggerWithSev) + -- | Fetch config from environment, fallback to sane defaults getConfig :: Int -> IO ServerConfig getConfig port = do @@ -90,10 +183,18 @@ -- * Talk -------------------------------------------------------------------------------- +data MainLog + = InitLog InitLog + | InteractiveLog InteractiveLog + +instance Pretty MainLog where + pretty = \ case + InitLog msg -> 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 :: LogAction IO (WithSeverity T.Text) -> Command -> DebugAdaptor () +talk :: Recorder (WithSeverity MainLog) -> Command -> DebugAdaptor () -------------------------------------------------------------------------------- talk l = \ case CommandInitialize -> do @@ -101,7 +202,7 @@ sendInitializeResponse -------------------------------------------------------------------------------- CommandLaunch -> do - success <- initDebugger l =<< getArguments + success <- initDebugger (cmapWithSev InitLog l) =<< getArguments if success then do sendLaunchResponse -- ack sendInitializedEvent -- our debugger is only ready to be configured after it has launched the session