phoityne-vscode 0.0.17.0 → 0.0.18.0
raw patch · 7 files changed
+79/−35 lines, 7 files
Files
- Changelog.md +5/−0
- README.md +5/−7
- app/Phoityne/GHCi/Command.hs +48/−16
- app/Phoityne/GHCi/Process.hs +18/−9
- app/Phoityne/VSCode/Control.hs +0/−1
- app/Phoityne/VSCode/Core.hs +2/−1
- phoityne-vscode.cabal +1/−1
Changelog.md view
@@ -1,4 +1,9 @@ +20171112 phoityne-vscode-0.0.18.0+ * [FIX] [29](https://github.com/phoityne/phoityne-vscode/issues/29) : Space in filename and reload on save bug.+ * [MODIFY] [20](https://github.com/phoityne/phoityne-vscode/issues/20) : During stopping on breakpoints selection is one character less.++ 20171008 phoityne-vscode-0.0.17.0 * [FIX] loading modules after ghci started, on ghc-8.2.1. * [ADD] [24](https://github.com/phoityne/phoityne-vscode/issues/24) : add variable "ghciInitialPrompt" to launch.json file.
README.md view
@@ -7,15 +7,13 @@ ## Information -* [2017/10/08] phoityne-vscode released. - * Marketplace [phoityne-vscode-0.0.15](https://marketplace.visualstudio.com/items?itemName=phoityne.phoityne-vscode)- * hackage [phoityne-vscode-0.0.17.0](https://hackage.haskell.org/package/phoityne-vscode) +* [2017/11/12] phoityne-vscode released. + * Marketplace [phoityne-vscode-0.0.16](https://marketplace.visualstudio.com/items?itemName=phoityne.phoityne-vscode)+ * hackage [phoityne-vscode-0.0.18.0](https://hackage.haskell.org/package/phoityne-vscode) __Need update from hackage !!.__ * Release Summary- * [FIX] loading modules after ghci started, on ghc-8.2.1.- * [ADD] [24](https://github.com/phoityne/phoityne-vscode/issues/24) : add variable "ghciInitialPrompt" to launch.json file.- * [ADD] [28](https://github.com/phoityne/phoityne-vscode/issues/28) : escape backslash of startup hs file path.- * [ADD] to set any start point, added startup function and arguments valiables in the launch.json file.+ * [FIX] [29](https://github.com/phoityne/phoityne-vscode/issues/29) : Space in filename and reload on save bug.+ * [MODIFY] [20](https://github.com/phoityne/phoityne-vscode/issues/20) : During stopping on breakpoints selection is one character less. 
app/Phoityne/GHCi/Command.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveDataTypeable #-}@@ -37,7 +36,7 @@ , complete ) where -import Phoityne.GHCi.Process+import Control.Concurrent import Text.Parsec import Data.Functor.Identity import Data.Char@@ -47,6 +46,8 @@ import qualified Data.String.Utils as U import qualified Data.Version as V +import Phoityne.GHCi.Process+ -- | -- _HS_FILE_EXT :: String@@ -138,15 +139,15 @@ outHdl "\n------------------------------------\n" setPrompt ghci - setPrompt ghci@(GHCiProcess _ _ _ _ pmt v) = set ghci outHdl ("prompt \"" ++ pmt ++ "\"") >>= \case+ setPrompt ghci@(GHCiProcess _ _ _ _ pmt v _) = set ghci outHdl ("prompt \"" ++ pmt ++ "\"") >>= \case Left err -> return $ Left err Right _ -> if v >= (V.Version [8, 2, 0] []) then setPromptCont ghci else setPrompt2 ghci - setPrompt2 ghci@(GHCiProcess _ _ _ _ pmt _) = set ghci outHdl ("prompt2 \"" ++ pmt ++ "\"") >>= \case+ setPrompt2 ghci@(GHCiProcess _ _ _ _ pmt _ _) = set ghci outHdl ("prompt2 \"" ++ pmt ++ "\"") >>= \case Left err -> return $ Left err Right _ -> return $ Right ghci - setPromptCont ghci@(GHCiProcess _ _ _ _ pmt _) = set ghci outHdl ("prompt-cont \"" ++ pmt ++ "\"") >>= \case+ setPromptCont ghci@(GHCiProcess _ _ _ _ pmt _ _) = set ghci outHdl ("prompt-cont \"" ++ pmt ++ "\"") >>= \case Left err -> return $ Left err Right _ -> return $ Right ghci @@ -209,10 +210,14 @@ loadFile ghci outHdl cmdArg = do let cmd = ":load " ++ (normalize cmdArg) outHdl $ cmd ++ "\n"- writeLine ghci cmd >>= \case++ lock ghci+ res <- writeLine ghci cmd >>= \case Left err -> return $ Left err Right _ -> readLineWhileIO ghci endOfLoadFile >>= withLoadResult+ unlock ghci + return res where endOfLoadFile acc = do let curStr = takeLastMsg acc@@ -249,7 +254,7 @@ normalize path | True == L.isPrefixOf "\"" path = path | False == L.isInfixOf " " path = path- | otherwise = "\"" ++ path ++ "\""+ | otherwise = "\"" ++ (U.replace "\\" "\\\\" path) ++ "\"" @@ -258,10 +263,15 @@ loadModule :: GHCiProcess -> OutputHandler -> [ModuleName] -> IO (Either ErrorData ()) loadModule ghci outHdl mods = do let cmd = ":module + *" ++ U.join " *" mods- exec ghci outHdl cmd >>= \case++ lock ghci+ res <- exec ghci outHdl cmd >>= \case Left err -> return $ Left err Right _ -> return $ Right ()-+ unlock ghci+ + return res+ -- | -- setBreak :: GHCiProcess@@ -272,10 +282,14 @@ -> IO (Either ErrorData (BreakId, SourcePosition)) setBreak ghci outHdl modName lineNo col = do let cmd = ":break " ++ modName ++ " " ++ show lineNo ++ (if (-1) == col then "" else " " ++ show col)- exec ghci outHdl cmd >>= \case++ lock ghci+ res <- exec ghci outHdl cmd >>= \case Left err -> return $ Left err Right msg -> getBreakId msg-+ unlock ghci+ + return res where getBreakId msg = case parse getBreakIdParser "getBreakId" msg of Right no -> return $ Right no @@ -295,10 +309,14 @@ -> IO (Either ErrorData (BreakId, SourcePosition)) setFuncBreak ghci outHdl name = do let cmd = ":break " ++ name- exec ghci outHdl cmd >>= \case++ lock ghci+ res <- exec ghci outHdl cmd >>= \case Left err -> return $ Left err Right msg -> getBreakId msg-+ unlock ghci+ + return res where getBreakId msg = case parse getBreakIdParser "getBreakId" msg of Right no -> return $ Right no @@ -315,10 +333,14 @@ delete :: GHCiProcess -> OutputHandler -> BreakId -> IO (Either ErrorData ()) delete ghci outHdl bid = do let cmd = ":delete " ++ show bid- exec ghci outHdl cmd >>= \case++ lock ghci+ res <- exec ghci outHdl cmd >>= \case Left err -> return $ Left err Right _ -> return $ Right ()-+ unlock ghci+ + return res -- | -- traceMain :: GHCiProcess -> OutputHandler -> IO (Either ErrorData (Maybe SourcePosition))@@ -528,7 +550,7 @@ parsePosition = do path <- manyTill anyChar (try (string (_HS_FILE_EXT ++ ":"))) (sl, sn, el, en) <- try parseA <|> try parseB <|> try parseC- return $ SourcePosition (drive2lower path ++ _HS_FILE_EXT) sl sn el en+ return $ SourcePosition (drive2lower path ++ _HS_FILE_EXT) sl sn el (en+1) where parseA = do ln <- manyTill digit (char ':')@@ -668,3 +690,13 @@ _ <- manyTill anyChar (try (string "<interactive>")) _ <- manyTill anyChar (char ' ') manyTill anyChar eof++-- |+--+lock :: GHCiProcess -> IO ()+lock ghci = takeMVar (lockGHCiProcess ghci) >> return ()++-- |+--+unlock :: GHCiProcess -> IO ()+unlock ghci = putMVar (lockGHCiProcess ghci) Lock
app/Phoityne/GHCi/Process.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveDataTypeable #-}@@ -8,6 +7,7 @@ module Phoityne.GHCi.Process ( ErrorData , GHCiProcess (..)+ , Lock(..) , _BASE_GHCI_VERSION , runProcess , exitProcess@@ -20,6 +20,7 @@ , readLineWhileIO ) where +import Control.Concurrent import GHC.IO.Encoding import Distribution.System import qualified System.Process as S@@ -44,6 +45,11 @@ -- |+-- command error message.+--+data Lock = Lock++-- | -- GHCi process data. -- data GHCiProcess = GHCiProcess@@ -54,6 +60,7 @@ , procGHCiProcess :: S.ProcessHandle , promptGHCiProcess :: String , versionGHCiProcess :: V.Version+ , lockGHCiProcess :: MVar Lock } -- |@@ -92,8 +99,10 @@ ghciProc <- S.runProcess cmd opts (Just cwd) runEnvs (Just fromPhoityneHandle) (Just toPhoityneHandle) (Just toPhoityneHandle) - return . Right $ GHCiProcess toGHCiHandle fromGHCiHandle fromGHCiHandle ghciProc pmt _BASE_GHCI_VERSION+ mvarLock <- newMVar Lock + return . Right $ GHCiProcess toGHCiHandle fromGHCiHandle fromGHCiHandle ghciProc pmt _BASE_GHCI_VERSION mvarLock+ where handlers = [ E.Handler someExcept ] someExcept (e :: E.SomeException) = return . Left . show $ e@@ -119,7 +128,7 @@ -- exit ghci. -- exitProcess :: GHCiProcess -> IO (Either ErrorData S.ExitCode)-exitProcess (GHCiProcess _ _ _ proc _ _) = flip E.catches handlers $ do+exitProcess (GHCiProcess _ _ _ proc _ _ _) = flip E.catches handlers $ do code <- S.waitForProcess proc return . Right $ code where@@ -130,7 +139,7 @@ -- write to ghci. -- writeLine :: GHCiProcess -> String -> IO (Either ErrorData ())-writeLine (GHCiProcess ghciIn _ _ _ _ _) writeData = flip E.catches handlers $ S.hIsOpen ghciIn >>= \case+writeLine (GHCiProcess ghciIn _ _ _ _ _ _) writeData = flip E.catches handlers $ S.hIsOpen ghciIn >>= \case True -> do S.hPutStrLn ghciIn writeData return $ Right ()@@ -143,7 +152,7 @@ -- read char till prompt. -- readTillPrompt :: GHCiProcess -> IO (Either ErrorData String)-readTillPrompt proc@(GHCiProcess _ _ _ _ pmt _) = readCharWhile proc (not . U.endswith pmt)+readTillPrompt proc@(GHCiProcess _ _ _ _ pmt _ _) = readCharWhile proc (not . U.endswith pmt) -- | -- read char till EOF.@@ -156,7 +165,7 @@ -- read char from ghci. -- readCharWhile :: GHCiProcess -> (String -> Bool) -> IO (Either ErrorData String)-readCharWhile (GHCiProcess _ ghciOut _ _ _ _) condProc = flip E.catches handlers $ S.hIsOpen ghciOut >>= \case+readCharWhile (GHCiProcess _ ghciOut _ _ _ _ _) condProc = flip E.catches handlers $ S.hIsOpen ghciOut >>= \case True -> go [] False -> return . Left $ "handle not open." where@@ -175,7 +184,7 @@ -- read char from ghci. -- readCharWhileIO :: GHCiProcess -> (String -> IO Bool) -> IO (Either ErrorData String)-readCharWhileIO (GHCiProcess _ ghciOut _ _ _ _) condProc = flip E.catches handlers $ S.hIsOpen ghciOut >>= \case+readCharWhileIO (GHCiProcess _ ghciOut _ _ _ _ _) condProc = flip E.catches handlers $ S.hIsOpen ghciOut >>= \case True -> go [] False -> return . Left $ "handle not open." where@@ -195,7 +204,7 @@ -- read line from ghci. -- readLineWhile :: GHCiProcess -> ([String] -> Bool) -> IO (Either ErrorData [String])-readLineWhile (GHCiProcess _ ghciOut _ _ _ _) condProc = flip E.catches handlers $ S.hIsOpen ghciOut >>= \case+readLineWhile (GHCiProcess _ ghciOut _ _ _ _ _) condProc = flip E.catches handlers $ S.hIsOpen ghciOut >>= \case True -> go [] False -> return . Left $ "handle not open." where@@ -215,7 +224,7 @@ -- read line from ghci. -- readLineWhileIO :: GHCiProcess -> ([String] -> IO Bool) -> IO (Either ErrorData [String])-readLineWhileIO (GHCiProcess _ ghciOut _ _ _ _) condProc = flip E.catches handlers $ S.hIsOpen ghciOut >>= \case+readLineWhileIO (GHCiProcess _ ghciOut _ _ _ _ _) condProc = flip E.catches handlers $ S.hIsOpen ghciOut >>= \case True -> go [] False -> return . Left $ "handle not open." where
app/Phoityne/VSCode/Control.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}
app/Phoityne/VSCode/Core.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -756,6 +755,8 @@ withExitCode (Right code) = do sendStdoutEvent mvarCtx $ show code+ sendStdoutEvent mvarCtx "\n"+ sendStdoutEvent mvarCtx "\n" resSeq <- getIncreasedResponseSequence mvarCtx sendResponse mvarCtx $ J.encode $ J.defaultDisconnectResponse resSeq req
phoityne-vscode.cabal view
@@ -1,5 +1,5 @@ name: phoityne-vscode-version: 0.0.17.0+version: 0.0.18.0 synopsis: ghci debug viewer on Visual Studio Code description: Please see README.md license: BSD3