diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,8 @@ +20221127 haskell-debug-adapter-0.0.38.0 + * [MODIFY] hdx4vsc ISSUE#27 Feature request: support jumping into library + * [INFO] support ghc-9.4.3. + + 20221024 haskell-debug-adapter-0.0.37.0 * [INFO] support ghc-8.10.7. diff --git a/haskell-debug-adapter.cabal b/haskell-debug-adapter.cabal --- a/haskell-debug-adapter.cabal +++ b/haskell-debug-adapter.cabal @@ -7,7 +7,7 @@ -- hash: 1a8a9f4202a32a5d5c37c676b9d919068955c6ff8fecee95e75927238459e56d name: haskell-debug-adapter -version: 0.0.37.0 +version: 0.0.38.0 synopsis: Haskell Debug Adapter. description: Please see README.md category: Development @@ -39,6 +39,7 @@ Haskell.Debug.Adapter.State.DebugRun.InternalTerminate Haskell.Debug.Adapter.State.DebugRun.Next Haskell.Debug.Adapter.State.DebugRun.Scopes + Haskell.Debug.Adapter.State.DebugRun.Source Haskell.Debug.Adapter.State.DebugRun.StackTrace Haskell.Debug.Adapter.State.DebugRun.StepIn Haskell.Debug.Adapter.State.DebugRun.Terminate @@ -111,8 +112,8 @@ , directory , filepath , fsnotify - , ghci-dap >=0.0.19.0 - , haskell-dap >=0.0.15.0 + , ghci-dap >=0.0.20.0 + , haskell-dap >=0.0.16.0 , hslogger , lens , mtl @@ -185,8 +186,8 @@ , directory , filepath , fsnotify - , ghci-dap >=0.0.19.0 - , haskell-dap >=0.0.15.0 + , ghci-dap >=0.0.20.0 + , haskell-dap >=0.0.16.0 , haskell-debug-adapter , hslogger , lens @@ -263,8 +264,8 @@ , directory , filepath , fsnotify - , ghci-dap >=0.0.19.0 - , haskell-dap >=0.0.15.0 + , ghci-dap >=0.0.20.0 + , haskell-dap >=0.0.16.0 , haskell-debug-adapter , hslogger , hspec diff --git a/src/Haskell/Debug/Adapter/Request.hs b/src/Haskell/Debug/Adapter/Request.hs --- a/src/Haskell/Debug/Adapter/Request.hs +++ b/src/Haskell/Debug/Adapter/Request.hs @@ -142,6 +142,7 @@ | "stackTrace" == DAP.commandRequest req = WrapRequest . StackTraceRequest <$> (liftEither (eitherDecode bs)) | "scopes" == DAP.commandRequest req = WrapRequest . ScopesRequest <$> (liftEither (eitherDecode bs)) | "variables" == DAP.commandRequest req = WrapRequest . VariablesRequest <$> (liftEither (eitherDecode bs)) + | "source" == DAP.commandRequest req = WrapRequest . SourceRequest <$> (liftEither (eitherDecode bs)) | "continue" == DAP.commandRequest req = WrapRequest . ContinueRequest <$> (liftEither (eitherDecode bs)) | "next" == DAP.commandRequest req = WrapRequest . NextRequest <$> (liftEither (eitherDecode bs)) | "stepIn" == DAP.commandRequest req = WrapRequest . StepInRequest <$> (liftEither (eitherDecode bs)) diff --git a/src/Haskell/Debug/Adapter/State/Contaminated.hs b/src/Haskell/Debug/Adapter/State/Contaminated.hs --- a/src/Haskell/Debug/Adapter/State/Contaminated.hs +++ b/src/Haskell/Debug/Adapter/State/Contaminated.hs @@ -45,6 +45,7 @@ doActivity s (WrapRequest r@StackTraceRequest{}) = action s r doActivity s (WrapRequest r@ScopesRequest{}) = action s r doActivity s (WrapRequest r@VariablesRequest{}) = action s r + doActivity s (WrapRequest r@SourceRequest{}) = action s r doActivity s (WrapRequest r@ContinueRequest{}) = action s r doActivity s (WrapRequest r@NextRequest{}) = action s r doActivity s (WrapRequest r@StepInRequest{}) = action s r @@ -207,6 +208,22 @@ } U.addResponse $ VariablesResponse res + return Nothing + +-- | +-- Any errors should be sent back as False result Response +-- +instance StateActivityIF ContaminatedStateData DAP.SourceRequest where + action _ (SourceRequest req) = do + resSeq <- U.getIncreasedResponseSequence + let res = DAP.defaultSourceResponse { + DAP.seqSourceResponse = resSeq + , DAP.request_seqSourceResponse = DAP.seqSourceRequest req + , DAP.successSourceResponse = False + , DAP.messageSourceResponse = "Contaminated State. need restart." + } + + U.addResponse $ SourceResponse res return Nothing -- | diff --git a/src/Haskell/Debug/Adapter/State/DebugRun.hs b/src/Haskell/Debug/Adapter/State/DebugRun.hs --- a/src/Haskell/Debug/Adapter/State/DebugRun.hs +++ b/src/Haskell/Debug/Adapter/State/DebugRun.hs @@ -19,6 +19,7 @@ import Haskell.Debug.Adapter.State.DebugRun.StackTrace() import Haskell.Debug.Adapter.State.DebugRun.Scopes() import Haskell.Debug.Adapter.State.DebugRun.Variables() +import Haskell.Debug.Adapter.State.DebugRun.Source() import Haskell.Debug.Adapter.State.DebugRun.Continue() import Haskell.Debug.Adapter.State.DebugRun.Next() import Haskell.Debug.Adapter.State.DebugRun.StepIn() @@ -56,6 +57,7 @@ doActivity s (WrapRequest r@StackTraceRequest{}) = action s r doActivity s (WrapRequest r@ScopesRequest{}) = action s r doActivity s (WrapRequest r@VariablesRequest{}) = action s r + doActivity s (WrapRequest r@SourceRequest{}) = action s r doActivity s (WrapRequest r@ContinueRequest{}) = action s r doActivity s (WrapRequest r@NextRequest{}) = action s r doActivity s (WrapRequest r@StepInRequest{}) = action s r diff --git a/src/Haskell/Debug/Adapter/State/DebugRun/Source.hs b/src/Haskell/Debug/Adapter/State/DebugRun/Source.hs new file mode 100644 --- /dev/null +++ b/src/Haskell/Debug/Adapter/State/DebugRun/Source.hs @@ -0,0 +1,78 @@ +module Haskell.Debug.Adapter.State.DebugRun.Source where + +import Control.Monad.IO.Class +import qualified System.Log.Logger as L +import qualified Text.Read as R +import Control.Monad.Except + + +import qualified Haskell.DAP as DAP +import Haskell.Debug.Adapter.Type +import Haskell.Debug.Adapter.Constant +import qualified Haskell.Debug.Adapter.Utility as U +import qualified Haskell.Debug.Adapter.GHCi as P +import qualified Haskell.Debug.Adapter.State.Utility as SU + + + +-- | +-- Any errors should be sent back as False result Response +-- +instance StateActivityIF DebugRunStateData DAP.SourceRequest where + action _ (SourceRequest req) = do + liftIO $ L.debugM _LOG_APP $ "DebugRunState SourceRequest called. " ++ show req + app req + + +-- | +-- +app :: DAP.SourceRequest -> AppContext (Maybe StateTransit) +app req = flip catchError errHdl $ do + + let args = DAP.argumentsSourceRequest req + dap = ":dap-source " + cmd = dap ++ U.showDAP args + dbg = dap ++ show args + + P.command cmd + U.debugEV _LOG_APP dbg + P.expectPmpt >>= SU.takeDapResult >>= dapHdl + + return Nothing + + where + + -- | + -- + dapHdl :: String -> AppContext () + dapHdl str = case R.readEither str of + Left err -> errHdl err >> return () + Right (Left err) -> errHdl err >> return () + Right (Right body) -> do + resSeq <- U.getIncreasedResponseSequence + let res = DAP.defaultSourceResponse { + DAP.seqSourceResponse = resSeq + , DAP.request_seqSourceResponse = DAP.seqSourceRequest req + , DAP.successSourceResponse = True + , DAP.bodySourceResponse = body + } + + U.addResponse $ SourceResponse res + + + -- | + -- + errHdl :: String -> AppContext (Maybe StateTransit) + errHdl msg = do + U.sendErrorEventLF msg + resSeq <- U.getIncreasedResponseSequence + let res = DAP.defaultSourceResponse { + DAP.seqSourceResponse = resSeq + , DAP.request_seqSourceResponse = DAP.seqSourceRequest req + , DAP.successSourceResponse = False + , DAP.messageSourceResponse = msg + } + + U.addResponse $ SourceResponse res + return Nothing + diff --git a/src/Haskell/Debug/Adapter/State/GHCiRun.hs b/src/Haskell/Debug/Adapter/State/GHCiRun.hs --- a/src/Haskell/Debug/Adapter/State/GHCiRun.hs +++ b/src/Haskell/Debug/Adapter/State/GHCiRun.hs @@ -42,6 +42,7 @@ doActivity s (WrapRequest r@StackTraceRequest{}) = action s r doActivity s (WrapRequest r@ScopesRequest{}) = action s r doActivity s (WrapRequest r@VariablesRequest{}) = action s r + doActivity s (WrapRequest r@SourceRequest{}) = action s r doActivity s (WrapRequest r@ContinueRequest{}) = action s r doActivity s (WrapRequest r@NextRequest{}) = action s r doActivity s (WrapRequest r@StepInRequest{}) = action s r @@ -173,6 +174,12 @@ U.addResponse $ VariablesResponse res return Nothing + + +-- | +-- default nop. +-- +instance StateActivityIF GHCiRunStateData DAP.SourceRequest -- | diff --git a/src/Haskell/Debug/Adapter/State/Init.hs b/src/Haskell/Debug/Adapter/State/Init.hs --- a/src/Haskell/Debug/Adapter/State/Init.hs +++ b/src/Haskell/Debug/Adapter/State/Init.hs @@ -44,6 +44,7 @@ doActivity s (WrapRequest r@StackTraceRequest{}) = action s r doActivity s (WrapRequest r@ScopesRequest{}) = action s r doActivity s (WrapRequest r@VariablesRequest{}) = action s r + doActivity s (WrapRequest r@SourceRequest{}) = action s r doActivity s (WrapRequest r@ContinueRequest{}) = action s r doActivity s (WrapRequest r@NextRequest{}) = action s r doActivity s (WrapRequest r@StepInRequest{}) = action s r @@ -107,6 +108,11 @@ -- default nop. -- instance StateActivityIF InitStateData DAP.VariablesRequest + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData DAP.SourceRequest -- | -- default nop. diff --git a/src/Haskell/Debug/Adapter/Type.hs b/src/Haskell/Debug/Adapter/Type.hs --- a/src/Haskell/Debug/Adapter/Type.hs +++ b/src/Haskell/Debug/Adapter/Type.hs @@ -184,6 +184,9 @@ $(deriveJSON defaultOptions {fieldLabelModifier = rdrop "VariablesRequestArguments", omitNothingFields = True} ''DAP.VariablesRequestArguments) $(deriveJSON defaultOptions {fieldLabelModifier = rdrop "VariablesRequest", omitNothingFields = True} ''DAP.VariablesRequest) +$(deriveJSON defaultOptions {fieldLabelModifier = rdrop "SourceRequestArguments", omitNothingFields = True} ''DAP.SourceRequestArguments) +$(deriveJSON defaultOptions {fieldLabelModifier = rdrop "SourceRequest", omitNothingFields = True} ''DAP.SourceRequest) + $(deriveJSON defaultOptions {fieldLabelModifier = rdrop "ContinueRequestArguments", omitNothingFields = True} ''DAP.ContinueRequestArguments) $(deriveJSON defaultOptions {fieldLabelModifier = rdrop "ContinueRequest", omitNothingFields = True} ''DAP.ContinueRequest) @@ -215,6 +218,7 @@ StackTraceRequest :: DAP.StackTraceRequest -> Request DAP.StackTraceRequest ScopesRequest :: DAP.ScopesRequest -> Request DAP.ScopesRequest VariablesRequest :: DAP.VariablesRequest -> Request DAP.VariablesRequest + SourceRequest :: DAP.SourceRequest -> Request DAP.SourceRequest ContinueRequest :: DAP.ContinueRequest -> Request DAP.ContinueRequest NextRequest :: DAP.NextRequest -> Request DAP.NextRequest StepInRequest :: DAP.StepInRequest -> Request DAP.StepInRequest @@ -278,6 +282,9 @@ $(deriveJSON defaultOptions {fieldLabelModifier = rdrop "VariablesResponseBody", omitNothingFields = True} ''DAP.VariablesResponseBody) $(deriveJSON defaultOptions {fieldLabelModifier = rdrop "VariablesResponse", omitNothingFields = True} ''DAP.VariablesResponse) +$(deriveJSON defaultOptions {fieldLabelModifier = rdrop "SourceResponseBody", omitNothingFields = True} ''DAP.SourceResponseBody) +$(deriveJSON defaultOptions {fieldLabelModifier = rdrop "SourceResponse", omitNothingFields = True} ''DAP.SourceResponse) + $(deriveJSON defaultOptions {fieldLabelModifier = rdrop "ContinueResponse", omitNothingFields = True} ''DAP.ContinueResponse) $(deriveJSON defaultOptions {fieldLabelModifier = rdrop "NextResponse", omitNothingFields = True} ''DAP.NextResponse) @@ -321,6 +328,7 @@ | StackTraceResponse DAP.StackTraceResponse | ScopesResponse DAP.ScopesResponse | VariablesResponse DAP.VariablesResponse + | SourceResponse DAP.SourceResponse | ContinueResponse DAP.ContinueResponse | NextResponse DAP.NextResponse | StepInResponse DAP.StepInResponse