phoityne-vscode 0.0.4.0 → 0.0.5.0
raw patch · 5 files changed
+95/−27 lines, 5 files
Files
- Changelog.md +4/−0
- README.md +10/−7
- app/Phoityne/IO/GUI/Control.hs +71/−10
- app/Phoityne/IO/GUI/VSCode/TH/LaunchRequestArgumentsJSON.hs +9/−9
- phoityne-vscode.cabal +1/−1
Changelog.md view
@@ -1,4 +1,8 @@ +20160605 phoityne-vscode-0.0.5.0++ * [Modify] launchリクエストのnoDebugパラメータをMaybeに変更した。+ 20160601 phoityne-vscode-0.0.4.0 * [Modify] スタックトレースの表示を番号から関数名に変更した。
README.md view
@@ -17,6 +17,15 @@ [](https://sites.google.com/site/phoityne/doc_jp/demo01.gif?attredirects=0) +## Key Bindings++* F5 : start debug+* F6 : show command menu (for stack watch)+* Shift + F6 : stop stack watch+* F7 : stack clean & build+* F8 : stack test++ ## Important * Breakpoint can be set in a .hs file which defineds "module ... where".@@ -36,7 +45,7 @@ Add 'phoityne-vscode.exe' to PATH environment. % where $path:phoityne-vscode.exe- C:\Users\phoityne\AppData\Roaming\local\bin\phoityne-vscode.exe+ C:\Users\[user name]\AppData\Roaming\local\bin\phoityne-vscode.exe % @@ -48,10 +57,4 @@ 3. select "[Haskell GHCi debug viewer Phoityne](https://marketplace.visualstudio.com/items?itemName=phoityne.phoityne-vscode)" -## Key Bindings -* F5 : start debug-* F6 : show command menu (for stack watch)-* Shift + F6 : stop stack watch-* F7 : stack clean & build-* F8 : stack test
app/Phoityne/IO/GUI/Control.hs view
@@ -265,9 +265,21 @@ , "}" ] ++ -- | -- --+_ERR_MSG_URL :: [String]+_ERR_MSG_URL = [ "`stack update` and install new phoityen-vscode."+ , "Or check information on https://marketplace.visualstudio.com/items?itemName=phoityne.phoityne-vscode"+ ]++++-- |+--+-- defaultDebugContext :: DebugContext defaultDebugContext = DebugContext _INITIAL_RESPONSE_SEQUENCE (MAP.fromList []) "" "" False Nothing 0 False @@ -321,6 +333,8 @@ len <- manyTill digit (string _TWO_CRLF) return . read $ len ++ -- | -- --@@ -328,9 +342,21 @@ handleRequest cmdData mvarCtx contLenStr jsonStr = do case J.eitherDecode jsonStr :: Either String J.Request of Left err -> do- let msg = L.intercalate " " ["request request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]- putStrLnStderr mvarCtx msg -- req_secが不明のため、エラー出力のみ行う。+ -- req_secが不明のため、エラー出力のみ行う。+ -- ただし、initializeが完了していない場合は、エラー出力イベントが受理されない。+ -- launchしていな場合はログ出力ができない。+ -- 無視して、次のリクエストを待つ。+ let msg = L.intercalate " " [ "request request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+ ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL)+ ++ "\n" + putStrLnStderr mvarCtx msg++ resSeq <- incResSeq mvarCtx+ let terminatedEvt = J.defaultTerminatedEvent resSeq+ terminatedEvtStr = J.encode terminatedEvt+ sendEventL terminatedEvtStr+ Right (J.Request cmd) -> handle contLenStr jsonStr cmd wait cmdData mvarCtx@@ -340,25 +366,35 @@ handle contLenStr jsonStr "initialize" = case J.eitherDecode jsonStr :: Either String J.InitializeRequest of Right req -> initializeHandler mvarCtx req Left err -> do- let msg = L.intercalate " " ["initialize request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+ -- initializeが完了していない場合は、エラー出力イベントが受理されない。+ -- responceをエラーで返す。メッセージは1行で作成する必要がある。+ -- launchしていな場合はログ出力ができない。+ -- res_seqは1固定とする。+ let msg = L.intercalate " " $ ["initialize request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err] ++ _ERR_MSG_URL resSeq <- incResSeq mvarCtx sendResponse $ J.encode $ J.parseErrorInitializeResponse resSeq msg- -- putStrLnStderr mvarCtx msg -- initialiezが完了していないと、イベントを受領してくれない。 handle contLenStr jsonStr "launch" = case J.eitherDecode jsonStr :: Either String J.LaunchRequest of Right req -> launchHandler cmdData mvarCtx req Left err -> do+ -- launchしていな場合はログ出力ができない。+ -- req_secが不明のため、エラー出力のみ行う。 let msg = L.intercalate " " ["launch request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]- -- resSeq <- incResSeq mvarCtx- -- sendResponse $ J.encode $ J.parceErrorLaunchResponse resSeq msg- putStrLnStderr mvarCtx msg -- req_secが不明のため、エラー出力のみ行う。+ ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"+ putStrLnStderr mvarCtx msg + resSeq <- incResSeq mvarCtx+ let terminatedEvt = J.defaultTerminatedEvent resSeq+ terminatedEvtStr = J.encode terminatedEvt+ sendEventL terminatedEvtStr + handle contLenStr jsonStr "disconnect" = case J.eitherDecode jsonStr :: Either String J.DisconnectRequest of Right req -> disconnectHandler cmdData mvarCtx req Left err -> do let msg = L.intercalate " " ["disconnect request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+ ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n" putStrLnStderr mvarCtx msg @@ -366,6 +402,7 @@ Right req -> setBreakpointsHandler cmdData mvarCtx req Left err -> do let msg = L.intercalate " " ["setBreakpoints request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+ ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n" putStrLnStderr mvarCtx msg @@ -373,6 +410,7 @@ Right req -> continueHandler cmdData mvarCtx req Left err -> do let msg = L.intercalate " " ["continue request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+ ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n" putStrLnStderr mvarCtx msg @@ -380,6 +418,7 @@ Right req -> stepOverHandler cmdData mvarCtx req Left err -> do let msg = L.intercalate " " ["next request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+ ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n" putStrLnStderr mvarCtx msg @@ -387,6 +426,7 @@ Right req -> stepInHandler cmdData mvarCtx req Left err -> do let msg = L.intercalate " " ["stepIn request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+ ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n" putStrLnStderr mvarCtx msg @@ -401,6 +441,7 @@ Left err -> do let msg = L.intercalate " " ["stepOut request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+ ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n" putStrLnStderr mvarCtx msg @@ -415,6 +456,7 @@ Left err -> do let msg = L.intercalate " " ["pause request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+ ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n" putStrLnStderr mvarCtx msg @@ -422,6 +464,7 @@ Right req -> stackTraceHandler cmdData mvarCtx req Left err -> do let msg = L.intercalate " " ["stackTrace request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+ ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n" putStrLnStderr mvarCtx msg @@ -429,6 +472,7 @@ Right req -> scopesHandler cmdData mvarCtx req Left err -> do let msg = L.intercalate " " ["scopes request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+ ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n" putStrLnStderr mvarCtx msg @@ -436,6 +480,7 @@ Right req -> variablesHandler cmdData mvarCtx req Left err -> do let msg = L.intercalate " " ["variables request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+ ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n" putStrLnStderr mvarCtx msg @@ -450,6 +495,7 @@ Left err -> do let msg = L.intercalate " " ["source request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+ ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n" putStrLnStderr mvarCtx msg @@ -457,6 +503,7 @@ Right req -> threadsHandler cmdData mvarCtx req Left err -> do let msg = L.intercalate " " ["threads request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+ ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n" putStrLnStderr mvarCtx msg @@ -464,6 +511,7 @@ Right req -> evaluateHandler cmdData mvarCtx req Left err -> do let msg = L.intercalate " " ["evaluate request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+ ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n" putStrLnStderr mvarCtx msg @@ -1356,11 +1404,11 @@ getResult = readDebugCommandData cmdData cmdStr <- setBreak modName lineNo- putStrLnStdout mvarCtx cmdStr+ -- putStrLnStdout mvarCtx cmdStr infoM _LOG_NAME cmdStr cmdStr <- getResult- putStrStdout mvarCtx cmdStr+ -- putStrStdout mvarCtx cmdStr infoM _LOG_NAME cmdStr case getBreakPointNo cmdStr of@@ -1712,7 +1760,20 @@ funcName <- manyTill anyChar (space >> char '(') filePath <- manyTill anyChar eof - return $ TraceData (strip traceId) funcName (init (strip filePath))+ return $ TraceData (strip traceId) (removeColorCode funcName) (init (strip filePath))++-- |+--+removeColorCode :: String -> String+removeColorCode str = case parse parser "removeColorCode" str of+ Right res -> res+ Left _ -> str+ where+ parser = do+ let _esc_code = chr 27+ char _esc_code >> char '[' >> anyChar >> char 'm' + funcName <- manyTill anyChar (char _esc_code)+ return funcName -- | -- バインディング値のパーサ
app/Phoityne/IO/GUI/VSCode/TH/LaunchRequestArgumentsJSON.hs view
@@ -12,15 +12,15 @@ -- data LaunchRequestArguments = LaunchRequestArguments {- noDebugLaunchRequestArguments :: Bool -- If noDebug is true the launch request should launch the program without enabling debugging.- , nameLaunchRequestArguments :: String -- Phoityne specific argument.- , typeLaunchRequestArguments :: String -- Phoityne specific argument.- , requestLaunchRequestArguments :: String -- Phoityne specific argument. must be "request"- , startupLaunchRequestArguments :: String -- Phoityne specific argument.- , workspaceLaunchRequestArguments :: String -- Phoityne specific argument.- , logFileLaunchRequestArguments :: String -- Phoityne specific argument.- , logLevelLaunchRequestArguments :: String -- Phoityne specific argument.- , ghciPromptLaunchRequestArguments :: String -- Phoityne specific argument.+ noDebugLaunchRequestArguments :: Maybe Bool -- If noDebug is true the launch request should launch the program without enabling debugging.+ , nameLaunchRequestArguments :: String -- Phoityne specific argument.+ , typeLaunchRequestArguments :: String -- Phoityne specific argument.+ , requestLaunchRequestArguments :: String -- Phoityne specific argument. must be "request"+ , startupLaunchRequestArguments :: String -- Phoityne specific argument.+ , workspaceLaunchRequestArguments :: String -- Phoityne specific argument.+ , logFileLaunchRequestArguments :: String -- Phoityne specific argument.+ , logLevelLaunchRequestArguments :: String -- Phoityne specific argument.+ , ghciPromptLaunchRequestArguments :: String -- Phoityne specific argument. } deriving (Show, Read, Eq)
phoityne-vscode.cabal view
@@ -1,5 +1,5 @@ name: phoityne-vscode-version: 0.0.4.0+version: 0.0.5.0 synopsis: ghci debug viewer on Visual Studio Code description: Please see README.md license: BSD3