haskell-dap 0.0.8.0 → 0.0.9.0
raw patch · 4 files changed
+152/−30 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Changelog.md +8/−2
- README.md +3/−2
- app/Haskell/DAP/GHCi/Command.hs +139/−24
- haskell-dap.cabal +2/−2
Changelog.md view
@@ -1,4 +1,10 @@ +20181014 haskell-dap-0.0.9.0++ * [MODIFY] logpoint output to console.+ * [FIX][[1](https://github.com/phoityne/hdx4vsc/issues/1)]debugger does not work with vscode-1.28.(Fixed with haskell-dap only.)++ 20180924 haskell-dap-0.0.8.0 * [ADD] GHCi gobal scope reference.@@ -6,13 +12,13 @@ 20180801 haskell-dap-0.0.7.0 - * [ADD] [2][support ghc-8.4](https://github.com/phoityne/haskell-dap/issues/2)+ * [ADD] [support ghc-8.4](https://github.com/phoityne/haskell-dap/issues/2) 20180601 haskell-dap-0.0.6.0 * [MODIFY] support VisualStudio2017.(see [hdx4vs](https://github.com/phoityne/hdx4vsc))- * [ADD] [3][ support Logpoints](https://github.com/phoityne/haskell-dap/issues/3)+ * [ADD] [ support Logpoints](https://github.com/phoityne/haskell-dap/issues/3) 20180601 haskell-dap-0.0.5.0
README.md view
@@ -7,8 +7,9 @@ ## Information -* [2018/09/24] Release haskel-dap-0.0.8.0. - * [ADD] GHCi gobal scope reference.+* [2018/10/21] Release haskel-dap-0.0.9.0. + * [MODIFY] logpoint output change to console.+ * [FIX][[1](https://github.com/phoityne/hdx4vsc/issues/1)]debugger does not work with vscode-1.28 ## Limitation
app/Haskell/DAP/GHCi/Command.hs view
@@ -14,6 +14,8 @@ import DataCon import DynFlags import RtClosureInspect +import InteractiveEvalTypes +import qualified Module as GHC import qualified GHCi.UI as GHCi import qualified GHCi.UI.Monad as GHCi hiding (runStmt) @@ -42,6 +44,10 @@ , ("dap-set-breakpoints", dapCmdRunner dapSetBreakpointsCommand ctx, noCompletion) , ("dap-set-function-breakpoints" , dapCmdRunner dapSetFunctionBreakpointsCommand ctx, noCompletion) + , ("dap-set-function-breakpoint" + , dapCmdRunner dapSetFuncBreakpointCommand ctx, noCompletion) + , ("dap-delete-breakpoint" + , dapCmdRunner dapDeleteBreakpointCommand ctx, noCompletion) , ("dap-continue", dapCmdRunner dapContinueCommand ctx, noCompletion) , ("dap-next", dapCmdRunner dapNextCommand ctx, noCompletion) , ("dap-step-in", dapCmdRunner dapStepInCommand ctx, noCompletion) @@ -397,26 +403,128 @@ -- | -- - getBpNo :: (D.FunctionBreakpoint, D.Breakpoint) -> [(Int, (D.FunctionBreakpoint, Int))] -> [(Int, (D.FunctionBreakpoint, Int))] + getBpNo :: (D.FunctionBreakpoint, D.Breakpoint) + -> [(Int, (D.FunctionBreakpoint, Int))] + -> [(Int, (D.FunctionBreakpoint, Int))] getBpNo (funcBP, bp) acc = case D.idBreakpoint bp of Nothing -> acc Just no -> (no, (funcBP, 0)) : acc ------------------------------------------------------------------------------------------------ +-- DAP Command :dap-set-function-breakpoint-adhoc +------------------------------------------------------------------------------------------------ -- | -- +dapSetFuncBreakpointCommand :: MVar DAPContext -> String -> GHCi.GHCi () +dapSetFuncBreakpointCommand ctxMVar argsStr = do + res <- withArgs (readDAP argsStr) + printDAP res + + where + withArgs (Left err) = return $ Left $ "[DAP][ERROR] " ++ err ++ " : " ++ argsStr + withArgs (Right (startup, funcBP)) = getModuleByFile startup >>= \case + Left err -> return $ Left err + Right modName -> do + let funcName = D.nameFunctionBreakpoint funcBP + argStr = modName ++ "." ++ funcName + + bp <- addBreakpoint argStr + liftIO $ updateBpCtx (funcBP, bp) + + return $ Right bp + {- + -- | + -- + addBP :: (String, D.FunctionBreakpoint) -> GHCi.GHCi (D.FunctionBreakpoint, D.Breakpoint) + addBP (startup, funcBP) = getModuleByFile startup >>= withMod funcBP + + withMod funcBP (Right modName) = do + let funcName = D.nameFunctionBreakpoint funcBP + argStr = modName ++ "." ++ funcName + + bp <- addBreakpoint argStr + + return (funcBP, bp) +-} + -- | + -- + updateBpCtx :: (D.FunctionBreakpoint, D.Breakpoint) -> IO () + updateBpCtx (funcBP, bp) = case D.idBreakpoint bp of + Nothing -> return () + Just no -> do + ctx <- takeMVar ctxMVar + let funcBpMap = funcBPsDAPContext ctx + + putMVar ctxMVar $ ctx{funcBPsDAPContext = M.insert no (funcBP, 0) funcBpMap} + + +-- | +-- +getModuleByFile :: String -> GHCi.GHCi (Either String String) +getModuleByFile srcPath = do + + modSums <- GHCi.getLoadedModules + let modPaths = map takeModPath modSums + + case filter (isPathMatch srcPath) modPaths of + ((m, _):[]) -> do + -- liftIO $ putStrLn $ "[DAP][INFO][dapSetBreakpointsCommand] " ++ p ++ " -> " ++ m + return $ Right m + _ -> return $ Left $ "[DAP][ERROR] loaded module can not find from path. <" ++ srcPath ++ "> " ++ show modPaths + + where + takeModPath ms = (GHC.moduleNameString (GHC.ms_mod_name ms), GHC.ms_hspp_file ms) + isPathMatch srcPath (_, p) = (nzPath srcPath) == (nzPath p) + +------------------------------------------------------------------------------------------------ +-- DAP Command :dap-delete-breakpoint-adhoc +------------------------------------------------------------------------------------------------ + +-- | +-- +dapDeleteBreakpointCommand :: MVar DAPContext -> String -> GHCi.GHCi () +dapDeleteBreakpointCommand ctxMVar argsStr = do + res <- withArgs (readDAP argsStr) + printDAP res + + where + withArgs (Left err) = return $ Left $ "[DAP][ERROR] " ++ err ++ " : " ++ argsStr + withArgs (Right bp) = withBpId $ D.idBreakpoint bp + + withBpId Nothing = return $ Left $ "[DAP][ERROR] breakpoint number not found. " ++ show argsStr + withBpId (Just bid) = do + delBreakpoint bid + liftIO $ updateBpCtx bid + return $ Right () + + -- | + -- + updateBpCtx :: Int -> IO () + updateBpCtx bid = do + ctx <- takeMVar ctxMVar + let funcBpMap = funcBPsDAPContext ctx + + putMVar ctxMVar $ ctx{funcBPsDAPContext = M.delete bid funcBpMap} + +------------------------------------------------------------------------------------------------ + +-- | +-- delBreakpoint :: Int -> GHCi.GHCi Bool delBreakpoint bpNoStr = do curSt <- GHCi.getGHCiState let curCount = GHCi.break_ctr curSt + -- liftIO $ putStrLn $ "[DAP][INFO] before func breaks : " ++ show curCount GHCi.deleteCmd (show bpNoStr) newSt <- GHCi.getGHCiState let newCount = GHCi.break_ctr newSt + -- liftIO $ putStrLn $ "[DAP][INFO] after func breaks : " ++ show newCount + -- TODO; GHCi.break_ctr is not changed. return (newCount == curCount - 1) @@ -646,7 +754,9 @@ } , hitCntSourceBreakpointInfo = curCnt} = do let newCnt = curCnt + 1 - stmt = "let _CNT = " ++ show newCnt ++ " in " ++ condStr + stmt = if L.isInfixOf "_CNT" condStr + then "let _CNT = " ++ show newCnt ++ " in " ++ condStr + else "let _CNT = " ++ show newCnt ++ " in _CNT " ++ condStr liftIO $ updateSrcBreakCounter no bpInfo{hitCntSourceBreakpointInfo = newCnt} @@ -673,7 +783,9 @@ funcBreakthroughCounterHandler _ (D.FunctionBreakpoint{D.hitConditionFunctionBreakpoint = Nothing}, _) = return Nothing funcBreakthroughCounterHandler no info@(D.FunctionBreakpoint{D.hitConditionFunctionBreakpoint = Just condStr}, curCnt) = do let newCnt = curCnt + 1 - stmt = "let _CNT = " ++ show newCnt ++ " in " ++ condStr + stmt = if L.isInfixOf "_CNT" condStr + then "let _CNT = " ++ show newCnt ++ " in " ++ condStr + else "let _CNT = " ++ show newCnt ++ " in _CNT " ++ condStr liftIO $ updateFuncBreakCounter no (fst info, newCnt) @@ -717,23 +829,22 @@ -- logPointHandler :: Int -> Maybe String -> GHCi.GHCi (Maybe Bool) logPointHandler _ Nothing = return Nothing - logPointHandler no (Just stmt) = runStmtDAP mvarCtx False stmt >>= \case - Left err -> do - let msg = "[DAP][ERROR] log statement fail. BPNO:" ++ show no ++ " " ++ stmt ++ " -> " ++ err - body = D.defaultOutputEventBody { D.outputOutputEventBody = msg - , D.categoryOutputEventBody = "stderr" } - liftIO $ putStrLn msg - - printOutputEventDAP (Right body) - - return $ Just False - - Right res -> do - let body = D.defaultOutputEventBody {D.outputOutputEventBody = D.resultEvaluateBody res} + logPointHandler no (Just stmt) = do + runStmtDAP mvarCtx False stmt >>= \case + Left err -> do + let msg = "[DAP][ERROR] logpoint evaluate statement error at BPNO:" ++ show no ++ " error:" ++ err + body = D.defaultOutputEventBody { D.outputOutputEventBody = msg + , D.categoryOutputEventBody = "stderr" } + printOutputEventDAP (Right body) + return $ Just False - printOutputEventDAP (Right body) + Right res -> do + let msg = D.resultEvaluateBody res ++ "\n" + body = D.defaultOutputEventBody { D.outputOutputEventBody = msg + , D.categoryOutputEventBody = "console"} - return $ Just True + printOutputEventDAP (Right body) + return $ Just True -- | @@ -751,8 +862,10 @@ , D.textStoppedEventBody = show e } -withExecResult _ reason (GHC.ExecBreak{GHC.breakInfo = Just _}) = do - return $ Right D.defaultStoppedEventBody { +withExecResult _ reason (GHC.ExecBreak{GHC.breakInfo = Just (BreakInfo _ _)}) = do + -- liftIO $ putStrLn $ "[DAP][DEBUG] " ++ GHC.moduleNameString (GHC.moduleName m) + -- liftIO $ putStrLn $ "[DAP][DEBUG] " ++ show n + return $ Right D.defaultStoppedEventBody { D.reasonStoppedEventBody = reason } @@ -1254,10 +1367,12 @@ GHCi.runStmt stmt GHC.RunToCompletion >>= \case Nothing -> Left <$> getRunStmtSourceError --- Just (GHC.ExecBreak _ Nothing) -> Left <$> getRunStmtSourceError --- Just (GHC.ExecBreak names _) -> names2EvalBody ctxMVar isRefable stmt names - Just (GHC.ExecBreak _ _) -> return $ Left $ "[DAP][ERROR] unexpected break result. " - Just (GHC.ExecComplete (Left msg) _) -> return $ Left $ "[DAP][ERROR] error runStmt result. " ++ show msg + Just (GHC.ExecBreak _ Nothing) -> return $ Left $ "unexpected break occured while evaluating stmt:" ++ stmt + Just (GHC.ExecBreak _ (Just (BreakInfo (GHC.Module _ modName) idx))) -> do + let modStr = GHC.moduleNameString modName + return $ Left $ "unexpected break occured. breakNo:" ++ show idx + ++ " in " ++ modStr ++ " while evaluating stmt:" ++ stmt + Just (GHC.ExecComplete (Left msg) _) -> return $ Left $ "runStmt error. " ++ show msg Just (GHC.ExecComplete (Right names) _) -> names2EvalBody ctxMVar isRefable stmt names
haskell-dap.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: bcc97d09974b62fea7bfc4402e5d609e3dc5d4d8b0be6cd630be026b9e99fa17+-- hash: 610c154d749679273b4df91119a0b15dcec5224657b35dd63fce719ba34d3aa2 name: haskell-dap-version: 0.0.8.0+version: 0.0.9.0 synopsis: haskell-dap is a GHCi having DAP interface. description: Please see README.md category: Development