haskell-debug-adapter 0.0.29.0 → 0.0.30.0
raw patch · 5 files changed
+94/−46 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Changelog.md +4/−0
- haskell-debug-adapter.cabal +2/−2
- src/Haskell/Debug/Adapter/GHCi.hs +3/−13
- src/Haskell/Debug/Adapter/State/Init/Launch.hs +71/−14
- src/Haskell/Debug/Adapter/Utility.hs +14/−17
Changelog.md view
@@ -1,5 +1,9 @@ +20190402 haskell-debug-adapter-0.0.30.0+ * [INFO] support ghci-dap-0.0.12.0.++ 20190301 haskell-debug-adapter-0.0.29.0 * [INFO] start developping, based on phoityne-vscode-0.0.28.0.
haskell-debug-adapter.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 791ada16dd7af898ca59de433a41178ba2a929d17d295460fedef363b7435edb+-- hash: 936ac0a678039fb371ec5218b03ba08c8d2bb157ef6e48a790ee90ffa813d461 name: haskell-debug-adapter-version: 0.0.29.0+version: 0.0.30.0 synopsis: Haskell Debug Adapter. description: Please see README.md category: Development
src/Haskell/Debug/Adapter/GHCi.hs view
@@ -13,11 +13,9 @@ import qualified System.Process as S import qualified System.IO as S import qualified System.Environment as S-import qualified Control.Exception.Safe as E import qualified Data.Map as M import qualified Data.List as L import qualified Data.String.Utils as U---import qualified System.Log.Logger as L import Haskell.Debug.Adapter.Type import qualified Haskell.Debug.Adapter.Utility as U@@ -33,7 +31,7 @@ -> M.Map String String -> AppContext () startGHCi cmd opts cwd envs = - liftIO (startGHCiIO cmd opts cwd envs) >>= liftEither >>= updateGHCi+ U.liftIOE (startGHCiIO cmd opts cwd envs) >>= liftEither >>= updateGHCi where updateGHCi proc = do@@ -49,7 +47,7 @@ -> FilePath -> M.Map String String -> IO (Either ErrMsg GHCiProc)-startGHCiIO cmd opts cwd envs = flip E.catches handlers $ do+startGHCiIO cmd opts cwd envs = do (fromPhoityneHandle, toGHCiHandle) <- S.createPipe (fromGHCiHandle, toPhoityneHandle) <- S.createPipe@@ -86,9 +84,6 @@ return . Right $ GHCiProc toGHCiHandle fromGHCiHandle fromGHCiHandle ghciGHCi where- handlers = [ E.Handler someExcept ]- someExcept (e :: E.SomeException) = return . Left . show $ e- -- | -- getReadHandleEncoding :: IO TextEncoding@@ -192,13 +187,8 @@ proc <- liftIO $ readMVar mver let hdl = proc^.wHdLGHCiProc - liftIO (goIO hdl cmd) >>= liftEither-- where- goIO hdl cmd = flip E.catchAny errHdl $ do- Right <$> S.hPutStrLn hdl cmd+ U.liftIOE (Right <$> S.hPutStrLn hdl cmd) >>= liftEither - errHdl e = return $ Left $ show e -- | -- write to ghci.
src/Haskell/Debug/Adapter/State/Init/Launch.hs view
@@ -40,7 +40,7 @@ -- @see https://microsoft.github.io/debug-adapter-protocol/overview -- app :: DAP.LaunchRequest -> AppContext (Maybe StateTransit)-app req = do+app req = flip catchError errHdl $ do setUpConfig req setUpLogger req@@ -53,7 +53,10 @@ -- must start here. can not start in the entry of GHCiRun State. -- because there is a transition from DebugRun to GHCiRun. startGHCi req- initGHCi+ setPrompt+ launchCmd req+ setMainArgs+ loadStarupFile -- dont send launch response here. -- it must send after configuration done response.@@ -66,7 +69,24 @@ return $ Just Init_GHCiRun + where+ -- |+ --+ errHdl :: String -> AppContext (Maybe StateTransit)+ errHdl msg = do+ liftIO $ L.errorM _LOG_APP msg+ resSeq <- U.getIncreasedResponseSequence+ let res = DAP.defaultLaunchResponse {+ DAP.seqLaunchResponse = resSeq+ , DAP.request_seqLaunchResponse = DAP.seqLaunchRequest req+ , DAP.successLaunchResponse = False+ , DAP.messageLaunchResponse = msg+ } + U.addResponse $ LaunchResponse res+ return Nothing++ -- | -- setUpConfig :: DAP.LaunchRequest -> AppContext ()@@ -159,8 +179,11 @@ cmdStr = DAP.ghciCmdLaunchRequestArguments args cmdList = filter (not.null) $ U.split " " cmdStr cmd = head cmdList- opts = tail cmdList+ + U.debugEV _LOG_APP $ show cmdList + opts <- addWithGHC (tail cmdList)+ appStores <- get cwd <- liftIO $ readMVar $ appStores^.workspaceAppStores @@ -202,19 +225,8 @@ mver <- view ghciVerAppStores <$> get liftIO $ putMVar mver v - -- | ---initGHCi :: AppContext ()-initGHCi = do- setPrompt- setMainArgs-- file <- view startupAppStores <$> get- SU.loadHsFile file---- |--- setPrompt :: AppContext () setPrompt = do p <- view ghciPmptAppStores <$> get@@ -230,8 +242,25 @@ return () + -- | --+launchCmd :: DAP.LaunchRequest -> AppContext ()+launchCmd req = do+ let args = DAP.argumentsLaunchRequest req+ dap = ":dap-launch "+ cmd = dap ++ U.showDAP args+ dbg = dap ++ show args++ P.cmdAndOut cmd+ U.debugEV _LOG_APP dbg+ P.expectH P.stdoutCallBk++ return ()+++-- |+-- setMainArgs :: AppContext () setMainArgs = view mainArgsAppStores <$> get >>= \case [] -> return ()@@ -242,6 +271,34 @@ P.expectH P.stdoutCallBk return ()+++-- |+--+loadStarupFile :: AppContext ()+loadStarupFile = do+ file <- view startupAppStores <$> get+ SU.loadHsFile file+++-- |+--+addWithGHC :: [String] -> AppContext [String]+addWithGHC [] = return []+addWithGHC cmds+ | L.elem "--with-ghc=haskell-dap" cmds = do+ U.infoEV _LOG_APP "can not use haskell-dap. deleting \"--with-ghc=haskell-dap\""+ addWithGHC $ L.delete "--with-ghc=haskell-dap" cmds+ | withGhciExists cmds = return cmds+ | "ghci" == head cmds = do+ U.infoEV _LOG_APP "\"--with-ghc\" option not found. adding \"--with-ghc=ghci-dap\""+ return $ head cmds:"--with-ghc=ghci-dap":tail cmds+ | otherwise = return cmds+ where+ withGhciExists [] = False+ withGhciExists (x:xs)+ | L.isPrefixOf "--with-ghc=" x = True+ | otherwise = withGhciExists xs -- |
src/Haskell/Debug/Adapter/Utility.hs view
@@ -419,13 +419,9 @@ >>= go where- go hdl = liftIO (goIO hdl) >>= liftEither+ go hdl = liftIOE (Right <$> S.hGetLine hdl) >>= liftEither - goIO hdl = flip E.catchAny errHdl $ do- Right <$> S.hGetLine hdl - errHdl = return . Left . show- -- | -- readChar :: S.Handle -> AppContext String@@ -437,13 +433,8 @@ >>= isNotEmpty where- go hdl = liftIO (goIO hdl) >>= liftEither+ go hdl = liftIOE (Right <$> S.hGetChar hdl) >>= liftEither - goIO hdl = flip E.catchAny errHdl $ do- Right <$> S.hGetChar hdl-- errHdl = return . Left . show- toString c = return [c] @@ -463,12 +454,7 @@ >>= isNotEmptyL where- go hdl = liftIO (goIO hdl) >>= liftEither-- goIO hdl = flip E.catchAny errHdl $ do- Right <$> BSL.hGet hdl c-- errHdl = return . Left . show+ go hdl = liftIOE (Right <$> BSL.hGet hdl c) >>= liftEither -- |@@ -519,5 +505,16 @@ evts <- liftIO $ takeMVar mvar liftIO $ putMVar mvar (evts++[evt]) ++-- |+--+liftIOE :: IO a -> AppContext a+liftIOE f = liftIO (go f) >>= liftEither+ where+ go :: IO b -> IO (Either String b)+ go f = E.catchAny (Right <$> f) errHdl++ errHdl :: E.SomeException -> IO (Either String a)+ errHdl = return . Left . show