phoityne-vscode 0.0.26.0 → 0.0.27.0
raw patch · 5 files changed
+276/−230 lines, 5 files
Files
- Changelog.md +6/−0
- README.md +50/−132
- app/Phoityne/GHCi/Command.hs +4/−2
- app/Phoityne/VSCode/Core.hs +214/−94
- phoityne-vscode.cabal +2/−2
Changelog.md view
@@ -1,4 +1,10 @@ +20181014 phoityne-vscode-0.0.27.0+ * [UPDATE] supported haskell-dap-0.0.9.0+ * [MODIFY] send dap output to vscode with DEBUG level. + * [FIX][[1](https://github.com/phoityne/hdx4vsc/issues/1)]debugger does not work with vscode-1.28.(Fixed with haskell-dap only.)++ 20180801 phoityne-vscode-0.0.26.0 * [UPDATE] supported haskell-dap-0.0.7.0
README.md view
@@ -1,163 +1,81 @@ -# Phoityne VSCode+# Requirements -Phoityne is a Haskell GHCi debug adapter for Visual Studio Code.+Install [phoityne-vscode](https://hackage.haskell.org/package/phoityne-vscode) from hackage. +## Especially for GHC8 -## Information-* [2018/08/01] phoityne-vscode released. - * Marketplace [phoityne-vscode-0.0.19](https://marketplace.visualstudio.com/items?itemName=phoityne.phoityne-vscode)- * hackage [phoityne-vscode-0.0.26.0](https://hackage.haskell.org/package/phoityne-vscode) - __Need update from hackage !!.__-* Release Summary- * [UPDATE] supported haskell-dap-0.0.7.0+ Install [phoityne-vscode](https://hackage.haskell.org/package/phoityne-vscode) and [haskell-dap](https://hackage.haskell.org/package/haskell-dap). + In the launch.json, add "--with-ghc=haskell-dap" to ghciCmd variable. - -(This sample project is available from [here](https://github.com/phoityne/stack-project-template).)+```+> stack install phoityne-vscode haskell-dap+``` -## Important+# Limitations -* __LIMITATION__: Source file extension must be ".hs"-* __LIMITATION__: Can not use STDIN handle while debugging. -* When you start debugging for the first time, .vscode/tasks.json will be created automatically. Then you can use F6, F7, F8 shortcut key.- * F5 : start debug- * F6 : show command menu (for stack watch)- * Shift + F6 : stop stack watch- * F7 : stack clean & build- * F8 : stack test- * F9 : put bp on current line- * Shift + F9 : put bp on current column-* While debugging, you can use F5, F9, F10, F11 shortcut key.- * F5 : jump to next bp- * F9 : put bp on the line- * Shift + F9 : put bp on the column- * F10 : step next- * F11 : step into+* The source file extension must be ".hs"+* Can not use STDIN handle while debugging. +* Using GHC7, see the [README](https://github.com/phoityne/hdx4vsc/blob/master/README_ghc7.md). -## Features+# Features -### Run to Cursor+## Continue & Steps -+ -### Bindings & Watch+## Stacktrace The variable added to watch will be forced. ----### Stack trace-----### Break condition----### Hit count break condition--Supports these operators.-* ==-* /=-* <, >-* <=, >=-* mod, %-* just digit is same with '>='----### Break on Exception--+ -### Repl & Completions----### and more--Better inspection. This is an experimental enhancement. -There are limitations and additional installation. -[Here are the details](https://github.com/phoityne/haskell-dap). -- --## Capabilites--* supportsConfigurationDoneRequest : **yes**-* supportsFunctionBreakpoints : **yes**-* supportsConditionalBreakpoints : **yes**-* supportsHitConditionalBreakpoints : **yes**-* supportsEvaluateForHovers : **yes**-* exceptionBreakpointFilters : **yes**-* supportsStepBack : no-* supportsSetVariable : no-* supportsRestartFrame : no-* supportsGotoTargetsRequest : no-* supportsStepInTargetsRequest : no-* supportsCompletionsRequest : **yes**-* supportsModulesRequest : no-* additionalModuleColumns : no-* supportedChecksumAlgorithms : no-* supportsRestartRequest : no-* supportsExceptionOptions : no-* supportsValueFormattingOptions : no-* supportsExceptionInfoRequest : no-* supportTerminateDebuggee : no-* supportsDelayedStackTraceLoading : no-* supportsLogPoints : **yes** (by haskell-dap)-+## Bindings -## Install+ -### Run stack install-- % stack install phoityne-vscode- . . . . .- %+## Break condition -Add 'phoityne-vscode.exe' to PATH environment.+ -Windows)+## Console output - % where $path:phoityne-vscode.exe- C:\Users\[user name]\AppData\Roaming\local\bin\phoityne-vscode.exe- - % phoityne-vscode --version- phoityne-vscode-x.x.x.x- %- % code+ -linux)+## Quick Start+This is a new experimental feature. +__Note!!__, This function will automatically change the .vscode / launch.json file.+ - $ which phoityne-vscode- ~/.local/bin/phoityne-vscode- $- $ phoityne-vscode --version- phoityne-vscode-x.x.x.x- $- $ code+# Shortcut keys -### Install vscode extensions+When you start debugging for the first time, .vscode/tasks.json will be created automatically. Then you can use F6, F7, F8 shortcut keys.+ * F5 : start debug+ * F6 : show command menu (for stack watch)+ * Shift + F6 : stop stack watch+ * F7 : stack clean & build+ * F8 : stack test+ * F9 : put a breakpoint on the current line+ * Shift + F9 : put a breakpoint on the current column -1. run VSCode and open stack project __Folder__ from file menu. -2. open Extensions from side menu of VSCode.-3. search "haskell" -4. select "[__Haskell GHCi debug adapter Phoityne__](https://marketplace.visualstudio.com/items?itemName=phoityne.phoityne-vscode)"+While debugging, you can use F5, F9, F10, F11 shortcut keys.+ * F5 : jump to next bp+ * F9 : put bp on the line+ * Shift + F9 : put bp on the column+ * F10 : step next+ * F11 : step into - + -## Configuration+# Configuration -### __.vscode/launch.json__+## __.vscode/launch.json__ |NAME|REQUIRED OR OPTIONAL|DEFAULT SETTING|DESCRIPTION| |:--|:--:|:--|:--|@@ -173,7 +91,7 @@ |logLevel|required|WARNING|internal log level.| -#### changing ghci initial prompt +### changing ghci initial prompt If you change ghci prompt in .ghci file, or ghci prompt is changed from "Prelude>" by applying _NoImplicitPrelude_ extension, set the initial prompt variable to same prompt string. @@ -187,7 +105,7 @@ Make sure needs of the last space, and don't forget adding it. -#### setting the startup hs file+### setting the startup hs file Set the startup variable to the path of .hs file in which main function is defined. @@ -199,7 +117,7 @@ % -#### setting the startup function+### setting the startup function If you want to run the specific function instead of main function, set the startupFunc variable. For example, when specifying the following startDebug function,@@ -221,7 +139,7 @@ % -#### changing log level+### changing log level For debuging phoityen itself, change the log level to DEBUG. Adding Issue with the debug log.@@ -234,7 +152,7 @@ % -### __.vscode/tasks.json__+## __.vscode/tasks.json__ |TASK NAME|REQUIRED OR OPTIONAL|DEFAULT SETTING|DESCRIPTION| |:--|:--:|:--|:--|
app/Phoityne/GHCi/Command.hs view
@@ -10,6 +10,7 @@ SourcePosition(..) , StackFrame(..) , BindingData(..)+ , _DAP_CMD_END , start , quit , set@@ -127,7 +128,8 @@ -> M.Map String String -> IO (Either ErrorData GHCiProcess) start outHdl cmd opts cwd initPmt pmt envs = do- outHdl $ L.intercalate " " $ (cmd : opts) ++ ["in " ++ cwd, "\n"]+ outHdl $ L.intercalate " " ["CWD:", cwd, "\n"]+ outHdl $ L.intercalate " " $ ("CMD:" : cmd : opts) ++ ["\n\n"] runProcess cmd opts cwd pmt envs >>= withProcess where withProcess (Left err) = return $ Left err@@ -728,7 +730,7 @@ return res where proc curStr _ = do- outHdl curStr+ outHdl (curStr ++ "\n") return $ curStr /= _DAP_CMD_END witResult (Left err ) = return $ Left err
app/Phoityne/VSCode/Core.hs view
@@ -478,6 +478,7 @@ _DAP_HEADER_OUTPUT_EVENT :: String _DAP_HEADER_OUTPUT_EVENT = "<<DAP_OUTPUT_EVENT>>" + -- | -- type DAPRequestHandler = MVar DebugContextData@@ -578,6 +579,33 @@ outEvtStr = J.encode outEvt{J.bodyOutputEvent = body} sendEvent mvarCtx outEvtStr ++-- |+--+commonDapOutHdl :: MVar DebugContextData -> String -> String -> String -> IO ()+commonDapOutHdl mvarCtx cmd args str = getLevel <$> getLogger _LOG_NAME >>= \case+ Just DEBUG -> do+ if | U.startswith _DAP_HEADER_OUTPUT_EVENT str ->+ outputEventHandler mvarCtx $ drop (length _DAP_HEADER_OUTPUT_EVENT) str++ | U.startswith cmd str -> sendStdoutEvent mvarCtx $ cmd ++ " " ++ args ++ "\n"++ | otherwise -> sendStdoutEvent mvarCtx str++ Just INFO -> do+ if | U.startswith _DAP_HEADER_OUTPUT_EVENT str ->+ outputEventHandler mvarCtx $ drop (length _DAP_HEADER_OUTPUT_EVENT) str++ | U.startswith cmd str -> sendStdoutEvent mvarCtx $ cmd ++ " ...\n"++ | U.startswith G._DAP_CMD_END str -> return ()+ + | otherwise -> sendStdoutEvent mvarCtx str++ _ -> do+ if | U.startswith _DAP_HEADER_OUTPUT_EVENT str ->+ outputEventHandler mvarCtx $ drop (length _DAP_HEADER_OUTPUT_EVENT) str+ | otherwise -> return () -- | --@@ -599,27 +627,29 @@ where + cmdStr = ":dap-set-breakpoints"+ go = getProcExcept mvarCtx >>= runDap runDap proc = do- let cmd = ":dap-set-breakpoints"- args = showDAP $ J.argumentsSetBreakpointsRequest req+ let args = showDAP $ J.argumentsSetBreakpointsRequest req - liftIO (G.dapCommand proc (outHdl mvarCtx req) cmd args) >>= exceptIO+ liftIO (G.dapCommand proc (outHdl mvarCtx req) cmdStr args) >>= exceptIO -- | -- outHdl :: MVar DebugContextData -> J.SetBreakpointsRequest -> String -> IO () outHdl mvarCtx req str = do- + infoM _LOG_NAME $ "[GHCi][STDOUT] " ++ str - if | U.startswith _DAP_HEADER str ->+ if | U.startswith _DAP_HEADER str -> do+ logLevelMay <- getLevel <$> getLogger _LOG_NAME+ when ((Just DEBUG) == logLevelMay) $ sendStdoutEvent mvarCtx str dapHdl mvarCtx req $ drop (length _DAP_HEADER) str- | U.startswith _DAP_HEADER_OUTPUT_EVENT str ->- outputEventHandler mvarCtx $ drop (length _DAP_HEADER_OUTPUT_EVENT) str- | otherwise -> return () + | otherwise -> commonDapOutHdl mvarCtx cmdStr (show req) str+ -- | -- dapHdl :: MVar DebugContextData -> J.SetBreakpointsRequest -> String -> IO ()@@ -647,6 +677,7 @@ resStr = J.encode res sendResponse mvarCtx resStr + -- | -- setFunctionBreakpointsRequestHandlerDAP :: DAPRequestHandler@@ -667,27 +698,29 @@ where + cmdStr = ":dap-set-function-breakpoints"+ go = getProcExcept mvarCtx >>= runDap runDap proc = do- let cmd = ":dap-set-function-breakpoints"- args = showDAP $ J.argumentsSetFunctionBreakpointsRequest req+ let args = showDAP $ J.argumentsSetFunctionBreakpointsRequest req - liftIO (G.dapCommand proc (outHdl mvarCtx req) cmd args) >>= exceptIO+ liftIO (G.dapCommand proc (outHdl mvarCtx req) cmdStr args) >>= exceptIO -- | -- outHdl :: MVar DebugContextData -> J.SetFunctionBreakpointsRequest -> String -> IO () outHdl mvarCtx req str = do- + infoM _LOG_NAME $ "[GHCi][STDOUT] " ++ str - if | U.startswith _DAP_HEADER str ->+ if | U.startswith _DAP_HEADER str -> do+ logLevelMay <- getLevel <$> getLogger _LOG_NAME+ when ((Just DEBUG) == logLevelMay) $ sendStdoutEvent mvarCtx str dapHdl mvarCtx req $ drop (length _DAP_HEADER) str- | U.startswith _DAP_HEADER_OUTPUT_EVENT str ->- outputEventHandler mvarCtx $ drop (length _DAP_HEADER_OUTPUT_EVENT) str- | otherwise -> return () + | otherwise -> commonDapOutHdl mvarCtx cmdStr (show req) str+ -- | -- dapHdl :: MVar DebugContextData -> J.SetFunctionBreakpointsRequest -> String -> IO ()@@ -761,41 +794,51 @@ -- | --- stopOnEntry _ True = do- resSeq <- getIncreasedResponseSequence mvarCtx- let res = J.defaultConfigurationDoneResponse resSeq req- resStr = J.encode res- sendResponse mvarCtx resStr+ cmdStr = ":dap-continue"+ + -- |+ --+ stopOnEntry proc True = do+ startupFile <- startupDebugContextData <$> readMVar mvarCtx+ startupFunc <- startupFuncDebugContextData <$> readMVar mvarCtx - resSeq <- getIncreasedResponseSequence mvarCtx- let stopEvt = J.defaultStoppedEvent resSeq- stopEvtStr = J.encode stopEvt- sendEvent mvarCtx stopEvtStr+ let funcName = if null startupFunc then "main" else startupFunc+ funcBp = (startupFile, J.FunctionBreakpoint funcName Nothing Nothing) - return $ Right []+ adhocSetFuncBreakpoint proc funcBp >>= \case+ Left err -> do+ errorM _LOG_NAME $ "set entry breakpoint failed. " ++ err ++ " : " ++ funcName ++ " : " ++ show funcBp+ sendErrRes mvarCtx req err+ stopOnEntry proc False+ Right bp -> do+ stopOnEntry proc False+ adhocDelBreakpoint proc bp -- | -- stopOnEntry proc False = do cmdArgs <- getContinueCmdArgs mvarCtx- let cmd = ":dap-continue"- args = showDAP $ J.ContinueArguments _THREAD_ID cmdArgs+ let args = showDAP $ J.ContinueArguments _THREAD_ID cmdArgs - G.dapCommand proc (outHdl mvarCtx req) cmd args+ G.dapCommand proc (outHdl mvarCtx req) cmdStr args + return $ Right ()+ -- | -- outHdl :: MVar DebugContextData -> J.ConfigurationDoneRequest -> String -> IO () outHdl mvarCtx req str = do- + infoM _LOG_NAME $ "[GHCi][STDOUT] " ++ str - if | U.startswith _DAP_HEADER str ->+ if | U.startswith _DAP_HEADER str -> do+ logLevelMay <- getLevel <$> getLogger _LOG_NAME+ when ((Just DEBUG) == logLevelMay) $ sendStdoutEvent mvarCtx str dapHdl mvarCtx req $ drop (length _DAP_HEADER) str- | U.startswith _DAP_HEADER_OUTPUT_EVENT str ->- outputEventHandler mvarCtx $ drop (length _DAP_HEADER_OUTPUT_EVENT) str- | otherwise -> return () + | otherwise -> commonDapOutHdl mvarCtx cmdStr (show req) str++ -- | -- dapHdl :: MVar DebugContextData -> J.ConfigurationDoneRequest -> String -> IO ()@@ -839,6 +882,60 @@ sendResponse mvarCtx resStr + -- |+ --+ adhocSetFuncBreakpoint :: G.GHCiProcess+ -> (FilePath, J.FunctionBreakpoint)+ -> IO (Either G.ErrorData J.Breakpoint)+ adhocSetFuncBreakpoint proc args = do+ let cmdStr = ":dap-set-function-breakpoint"+ G.dapCommand proc (adhocOutHdl mvarCtx (show args) cmdStr) cmdStr (showDAP args) >>= \case+ Left err -> return $ Left err+ Right strs -> withAdhocAddDapHeader $ filter (U.startswith _DAP_HEADER) strs+++ -- |+ --+ withAdhocAddDapHeader :: [String] -> IO (Either G.ErrorData J.Breakpoint)+ withAdhocAddDapHeader [] = return $ Left "[ERROR] can not set func breakpoint. no dap header found."+ withAdhocAddDapHeader (str:[]) = case R.readEither (drop (length _DAP_HEADER) str) of+ Left err -> return $ Left $ "[ERROR] read response body failed. " ++ err ++ " : " ++ str+ Right (Left err) -> return $ Left $ "[ERROR] set adhoc breakpoint failed. " ++ err ++ " : " ++ str+ Right (Right res) -> return $ Right res+ withAdhocAddDapHeader _ = return $ Left "[ERROR] can not set func breakpoint. ambiguous dap header found."+++ -- |+ --+ adhocDelBreakpoint :: G.GHCiProcess -> J.Breakpoint -> IO (Either G.ErrorData ())+ adhocDelBreakpoint proc args = do+ let cmdStr = ":dap-delete-breakpoint"+ G.dapCommand proc (adhocOutHdl mvarCtx (show args) cmdStr) cmdStr (showDAP args) >>= \case+ Left err -> return $ Left err+ Right strs -> withAdhocDelDapHeader $ filter (U.startswith _DAP_HEADER) strs++ -- |+ --+ withAdhocDelDapHeader :: [String] -> IO (Either G.ErrorData ())+ withAdhocDelDapHeader [] = return $ Left "[ERROR] can not del func breakpoint. no dap header found."+ withAdhocDelDapHeader (str:[]) = case R.readEither (drop (length _DAP_HEADER) str) of+ Left err -> return $ Left $ "[ERROR] read response body failed. " ++ err ++ " : " ++ str+ Right (Left err) -> return $ Left $ "[ERROR] del adhoc breakpoint failed. " ++ err ++ " : " ++ str+ Right (Right res) -> return $ Right res+ withAdhocDelDapHeader _ = return $ Left "[ERROR] can not del func breakpoint. ambiguous dap header found."++ -- |+ --+ adhocOutHdl :: MVar DebugContextData -> String -> String -> String -> IO ()+ adhocOutHdl mvarCtx reqStr cmdStr str = do++ infoM _LOG_NAME $ "[GHCi][STDOUT] " ++ str++ if | U.startswith _DAP_HEADER str -> do+ logLevelMay <- getLevel <$> getLogger _LOG_NAME+ when ((Just DEBUG) == logLevelMay) $ sendStdoutEvent mvarCtx str+ | otherwise -> commonDapOutHdl mvarCtx cmdStr reqStr str+ -- | -- continueRequestHandlerDAP :: DAPRequestHandler@@ -859,6 +956,8 @@ where + cmdStr = ":dap-continue"+ -- | -- go = getProcExcept mvarCtx >>= runDap@@ -867,25 +966,27 @@ -- runDap proc = do cmdArgs <- liftIO $ getContinueCmdArgs mvarCtx- let cmd = ":dap-continue"- reqArgs= J.argumentsContinueRequest req+ let reqArgs= J.argumentsContinueRequest req args = showDAP $ reqArgs { J.exprContinueArguments = cmdArgs } - liftIO (G.dapCommand proc (outHdl mvarCtx req) cmd args) >>= exceptIO+ liftIO (G.dapCommand proc (outHdl mvarCtx req) cmdStr args) >>= exceptIO -- | -- outHdl :: MVar DebugContextData -> J.ContinueRequest -> String -> IO () outHdl mvarCtx req str = do- + infoM _LOG_NAME $ "[GHCi][STDOUT] " ++ str - if | U.startswith _DAP_HEADER str ->+ if | U.startswith _DAP_HEADER str -> do+ logLevelMay <- getLevel <$> getLogger _LOG_NAME+ when ((Just DEBUG) == logLevelMay) $ sendStdoutEvent mvarCtx str dapHdl mvarCtx req $ drop (length _DAP_HEADER) str- | U.startswith _DAP_HEADER_OUTPUT_EVENT str ->- outputEventHandler mvarCtx $ drop (length _DAP_HEADER_OUTPUT_EVENT) str- | otherwise -> return () + | otherwise -> commonDapOutHdl mvarCtx cmdStr (show req) str+++ -- | -- dapHdl :: MVar DebugContextData -> J.ContinueRequest -> String -> IO ()@@ -966,27 +1067,29 @@ where + cmdStr = ":dap-next"+ go = getProcExcept mvarCtx >>= runDap runDap proc = do- let cmd = ":dap-next"- args = showDAP $ J.argumentsNextRequest req+ let args = showDAP $ J.argumentsNextRequest req - liftIO (G.dapCommand proc (outHdl mvarCtx req) cmd args) >>= exceptIO+ liftIO (G.dapCommand proc (outHdl mvarCtx req) cmdStr args) >>= exceptIO -- | -- outHdl :: MVar DebugContextData -> J.NextRequest -> String -> IO () outHdl mvarCtx req str = do- + infoM _LOG_NAME $ "[GHCi][STDOUT] " ++ str - if | U.startswith _DAP_HEADER str ->+ if | U.startswith _DAP_HEADER str -> do+ logLevelMay <- getLevel <$> getLogger _LOG_NAME+ when ((Just DEBUG) == logLevelMay) $ sendStdoutEvent mvarCtx str dapHdl mvarCtx req $ drop (length _DAP_HEADER) str- | U.startswith _DAP_HEADER_OUTPUT_EVENT str ->- outputEventHandler mvarCtx $ drop (length _DAP_HEADER_OUTPUT_EVENT) str- | otherwise -> return () + | otherwise -> commonDapOutHdl mvarCtx cmdStr (show req) str+ -- | -- dapHdl :: MVar DebugContextData -> J.NextRequest -> String -> IO ()@@ -1047,27 +1150,29 @@ where + cmdStr = ":dap-step-in"+ go = getProcExcept mvarCtx >>= runDap runDap proc = do- let cmd = ":dap-step-in"- args = showDAP $ J.argumentsStepInRequest req+ let args = showDAP $ J.argumentsStepInRequest req - liftIO (G.dapCommand proc (outHdl mvarCtx req) cmd args) >>= exceptIO+ liftIO (G.dapCommand proc (outHdl mvarCtx req) cmdStr args) >>= exceptIO -- | -- outHdl :: MVar DebugContextData -> J.StepInRequest -> String -> IO () outHdl mvarCtx req str = do- + infoM _LOG_NAME $ "[GHCi][STDOUT] " ++ str - if | U.startswith _DAP_HEADER str ->+ if | U.startswith _DAP_HEADER str -> do+ logLevelMay <- getLevel <$> getLogger _LOG_NAME+ when ((Just DEBUG) == logLevelMay) $ sendStdoutEvent mvarCtx str dapHdl mvarCtx req $ drop (length _DAP_HEADER) str- | U.startswith _DAP_HEADER_OUTPUT_EVENT str ->- outputEventHandler mvarCtx $ drop (length _DAP_HEADER_OUTPUT_EVENT) str- | otherwise -> return () + | otherwise -> commonDapOutHdl mvarCtx cmdStr (show req) str+ -- | -- dapHdl :: MVar DebugContextData -> J.StepInRequest -> String -> IO ()@@ -1127,27 +1232,29 @@ where + cmdStr = ":dap-stacktrace"+ go = getProcExcept mvarCtx >>= runDap runDap proc = do- let cmd = ":dap-stacktrace"- args = showDAP $ J.argumentsStackTraceRequest req+ let args = showDAP $ J.argumentsStackTraceRequest req - liftIO (G.dapCommand proc (outHdl mvarCtx req) cmd args) >>= exceptIO+ liftIO (G.dapCommand proc (outHdl mvarCtx req) cmdStr args) >>= exceptIO -- | -- outHdl :: MVar DebugContextData -> J.StackTraceRequest -> String -> IO () outHdl mvarCtx req str = do- + infoM _LOG_NAME $ "[GHCi][STDOUT] " ++ str - if | U.startswith _DAP_HEADER str ->+ if | U.startswith _DAP_HEADER str -> do+ logLevelMay <- getLevel <$> getLogger _LOG_NAME+ when ((Just DEBUG) == logLevelMay) $ sendStdoutEvent mvarCtx str dapHdl mvarCtx req $ drop (length _DAP_HEADER) str- | U.startswith _DAP_HEADER_OUTPUT_EVENT str ->- outputEventHandler mvarCtx $ drop (length _DAP_HEADER_OUTPUT_EVENT) str- | otherwise -> return () + | otherwise -> commonDapOutHdl mvarCtx cmdStr (show req) str+ -- | -- dapHdl :: MVar DebugContextData -> J.StackTraceRequest -> String -> IO ()@@ -1156,10 +1263,18 @@ errorM _LOG_NAME $ "read response body failed. " ++ err ++ " : " ++ str sendErrRes mvarCtx req err - Right (Left err) -> do- errorM _LOG_NAME $ "stackTraceRequestHandler failed. " ++ err ++ " : " ++ str- sendErrRes mvarCtx req err+ Right (Left err) -> debugStartedDebugContextData <$> readMVar mvarCtx >>= \case+ False -> do+ errorM _LOG_NAME $ "stackTraceRequestHandler failed. " ++ err ++ " : " ++ str+ sendErrRes mvarCtx req err + True -> do+ errorM _LOG_NAME $ "stackTraceRequestHandler failed. " ++ err ++ " : " ++ str+ sendErrRes mvarCtx req err+ sendConsoleEvent mvarCtx $ " No stack trace is found. It seems that GHCi has ended debugging.\n"+ sendConsoleEvent mvarCtx $ " Exitting haskell debugger.\n"+ sendTerminateEvent mvarCtx+ Right (Right body) -> do resSeq <- getIncreasedResponseSequence mvarCtx let res = J.defaultStackTraceResponse resSeq req@@ -1195,28 +1310,30 @@ where + cmdStr = ":dap-scopes"+ go = getProcExcept mvarCtx >>= runDap runDap proc = do- let cmd = ":dap-scopes"- args = showDAP $ J.argumentsScopesRequest req+ let args = showDAP $ J.argumentsScopesRequest req - liftIO (G.dapCommand proc (outHdl mvarCtx req) cmd args) >>= exceptIO+ liftIO (G.dapCommand proc (outHdl mvarCtx req) cmdStr args) >>= exceptIO -- | -- outHdl :: MVar DebugContextData -> J.ScopesRequest -> String -> IO () outHdl mvarCtx req str = do- + infoM _LOG_NAME $ "[GHCi][STDOUT] " ++ str - if | U.startswith _DAP_HEADER str ->+ if | U.startswith _DAP_HEADER str -> do+ logLevelMay <- getLevel <$> getLogger _LOG_NAME+ when ((Just DEBUG) == logLevelMay) $ sendStdoutEvent mvarCtx str dapHdl mvarCtx req $ drop (length _DAP_HEADER) str- | U.startswith _DAP_HEADER_OUTPUT_EVENT str ->- outputEventHandler mvarCtx $ drop (length _DAP_HEADER_OUTPUT_EVENT) str- | otherwise -> return () + | otherwise -> commonDapOutHdl mvarCtx cmdStr (show req) str+ -- | -- dapHdl :: MVar DebugContextData -> J.ScopesRequest -> String -> IO ()@@ -1264,27 +1381,29 @@ where + cmdStr = ":dap-variables"+ go = getProcExcept mvarCtx >>= runDap runDap proc = do- let cmd = ":dap-variables"- args = showDAP $ J.argumentsVariablesRequest req+ let args = showDAP $ J.argumentsVariablesRequest req - liftIO (G.dapCommand proc (outHdl mvarCtx req) cmd args) >>= exceptIO+ liftIO (G.dapCommand proc (outHdl mvarCtx req) cmdStr args) >>= exceptIO -- | -- outHdl :: MVar DebugContextData -> J.VariablesRequest -> String -> IO () outHdl mvarCtx req str = do- + infoM _LOG_NAME $ "[GHCi][STDOUT] " ++ str - if | U.startswith _DAP_HEADER str ->+ if | U.startswith _DAP_HEADER str -> do+ logLevelMay <- getLevel <$> getLogger _LOG_NAME+ when ((Just DEBUG) == logLevelMay) $ sendStdoutEvent mvarCtx str dapHdl mvarCtx req $ drop (length _DAP_HEADER) str- | U.startswith _DAP_HEADER_OUTPUT_EVENT str ->- outputEventHandler mvarCtx $ drop (length _DAP_HEADER_OUTPUT_EVENT) str- | otherwise -> return () + | otherwise -> commonDapOutHdl mvarCtx cmdStr (show req) str+ -- | -- dapHdl :: MVar DebugContextData -> J.VariablesRequest -> String -> IO ()@@ -1332,29 +1451,30 @@ Left err -> sendErrRes mvarCtx req err where-+ cmdStr = ":dap-evaluate"+ go = getProcExcept mvarCtx >>= runDap runDap proc = do- let cmd = ":dap-evaluate"- args = J.argumentsEvaluateRequest req+ let args = J.argumentsEvaluateRequest req dapArgs = showDAP args - liftIO (G.dapCommand proc (outHdl mvarCtx req) cmd dapArgs) >>= exceptIO+ liftIO (G.dapCommand proc (outHdl mvarCtx req) cmdStr dapArgs) >>= exceptIO -- | -- outHdl :: MVar DebugContextData -> J.EvaluateRequest -> String -> IO () outHdl mvarCtx req str = do- + infoM _LOG_NAME $ "[GHCi][STDOUT] " ++ str - if | U.startswith _DAP_HEADER str ->+ if | U.startswith _DAP_HEADER str -> do+ logLevelMay <- getLevel <$> getLogger _LOG_NAME+ when ((Just DEBUG) == logLevelMay) $ sendStdoutEvent mvarCtx str dapHdl mvarCtx req $ drop (length _DAP_HEADER) str- | U.startswith _DAP_HEADER_OUTPUT_EVENT str ->- outputEventHandler mvarCtx $ drop (length _DAP_HEADER_OUTPUT_EVENT) str- | otherwise -> return ()++ | otherwise -> commonDapOutHdl mvarCtx cmdStr (show req) str -- | --
phoityne-vscode.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: b19b0fcf2dcc588b7530ff1f713fa07c43cf33b004dcb6825997aa462b0658fb+-- hash: 2e3d81bba7298c6b250fac3885e94bd14ecd597e7e17391774f5411f2375b1fc name: phoityne-vscode-version: 0.0.26.0+version: 0.0.27.0 synopsis: Haskell Debug Adapter for Visual Studio Code. description: Please see README.md category: Development