phoityne-vscode 0.0.18.0 → 0.0.19.0
raw patch · 7 files changed
+249/−42 lines, 7 files
Files
- Changelog.md +6/−0
- README.md +7/−6
- app/Phoityne/GHCi/Command.hs +16/−0
- app/Phoityne/VSCode/Core.hs +153/−32
- app/Phoityne/VSCode/TH/VariableJSON.hs +7/−3
- app/Phoityne/VSCode/TH/VariablePresentationHintJSON.hs +58/−0
- phoityne-vscode.cabal +2/−1
Changelog.md view
@@ -1,4 +1,10 @@ +20171216 phoityne-vscode-0.0.19.0+ * [ADD] checking hackage package version and inform on console if using lower version.+ * [MODIFY] Supporting Multi-root Workspaces. version up tasks.json.+ * [MODIFY] Supporting Multi-root Workspaces. setBreakpointsRequest. ++ 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.
README.md view
@@ -7,14 +7,15 @@ ## Information -* [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) +* [2017/12/16] phoityne-vscode released. + * Marketplace [phoityne-vscode-0.0.17](https://marketplace.visualstudio.com/items?itemName=phoityne.phoityne-vscode)+ * hackage [phoityne-vscode-0.0.19.0](https://hackage.haskell.org/package/phoityne-vscode) __Need update from hackage !!.__ * Release Summary- * [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.- + * [ADD] checking hackage package version and inform on console if using lower version.+ * [MODIFY] Supporting Multi-root Workspaces. version up tasks.json.+ * [MODIFY] Supporting Multi-root Workspaces. setBreakpointsRequest. + __Need recreate .vscde/launch.json and tasks.json in the project folder !!.__  (This sample project is available from [here](https://github.com/phoityne/stack-project-template).)
app/Phoityne/GHCi/Command.hs view
@@ -27,6 +27,7 @@ , back , forward , bindings+ , bindingsDAP , force , info , showType@@ -431,7 +432,20 @@ if 1 == length msgs then return $ Right [] else return $ extractBindingBindingDatas $ unlines $ init $ msgs +-- |+--+bindingsDAP :: GHCiProcess -> OutputHandler -> Int -> IO (Either ErrorData String)+bindingsDAP ghci outHdl idx = do+ let cmd = ":dap-bindings " ++ show idx+ dapHead = "<<DAP>>"+ exec ghci outHdl cmd >>= \case+ Left err -> return $ Left err+ Right msg -> do+ let msgs = filter (L.isPrefixOf dapHead) $ lines msg+ if 1 == length msgs then return $ Right $ drop (length dapHead) $ head msgs+ else return $ Left $ "[dap] error. header " ++ dapHead ++ "not found. " ++ msg + -- | -- force :: GHCiProcess -> OutputHandler -> String -> IO (Either ErrorData String)@@ -700,3 +714,5 @@ -- unlock :: GHCiProcess -> IO () unlock ghci = putMVar (lockGHCiProcess ghci) Lock++
app/Phoityne/VSCode/Core.hs view
@@ -108,6 +108,7 @@ import qualified Phoityne.VSCode.TH.ThreadsRequestJSON as J import qualified Phoityne.VSCode.TH.ThreadsResponseJSON as J import qualified Phoityne.VSCode.TH.VariableJSON as J+import qualified Phoityne.VSCode.TH.VariablesArgumentsJSON as J import qualified Phoityne.VSCode.TH.VariablesBodyJSON as J import qualified Phoityne.VSCode.TH.VariablesRequestJSON as J import qualified Phoityne.VSCode.TH.VariablesResponseJSON as J@@ -132,7 +133,8 @@ , ghciProcessDebugContextData :: Maybe G.GHCiProcess , responseHandlerDebugContextData :: BSL.ByteString -> IO () , stopOnEntryDebugContextData :: Bool- , hackagePackageVersionDebugContextData :: String + , hackagePackageVersionDebugContextData :: String+ , haskellDapEnabledDebugContextData :: Bool } @@ -160,7 +162,14 @@ -- type BreakPointDatas = M.Map BreakPointDataKey BreakPointData + -- |+--+_HASKELL_DAP_EXE :: String+_HASKELL_DAP_EXE = "haskell-dap"+++-- | -- -- getBreakPointKey :: BreakPointData -> BreakPointDataKey@@ -202,41 +211,41 @@ "{" , " // atuomatically created by phoityne-vscode" , " "- , " \"version\": \"0.1.0\","- , " \"isShellCommand\": true,"- , " \"showOutput\": \"always\","- , " \"suppressTaskName\": true,"- , " \"windows\": {"- , " \"command\": \"cmd\","- , " \"args\": [\"/c\"]"- , " },"- , " \"linux\": {"- , " \"command\": \"sh\","- , " \"args\": [\"-c\"]"- , " },"- , " \"osx\": {"- , " \"command\": \"sh\","- , " \"args\": [\"-c\"]"+ , " \"version\": \"2.0.0\","+ , " \"presentation\": {"+ , " \"reveal\": \"always\","+ , " \"panel\": \"new\"" , " }," , " \"tasks\": [" , " {"- , " \"taskName\": \"stack build\","- , " \"args\": [ \"echo START_STACK_BUILD && cd ${workspaceRoot} && stack build && echo END_STACK_BUILD \" ]"+ , " \"group\": {"+ , " \"kind\": \"build\","+ , " \"isDefault\": true"+ , " },"+ , " \"label\": \"stack build\","+ , " \"type\": \"shell\","+ , " \"command\": \"echo START_STACK_BUILD && cd ${workspaceRoot} && stack build && echo END_STACK_BUILD \"" , " }," , " { "- , " \"isBuildCommand\": true,"- , " \"taskName\": \"stack clean & build\","- , " \"args\": [ \"echo START_STACK_CLEAN_AND_BUILD && cd ${workspaceRoot} && stack clean && stack build && echo END_STACK_CLEAN_AND_BUILD \" ]"+ , " \"group\": \"build\","+ , " \"type\": \"shell\","+ , " \"label\": \"stack clean & build\","+ , " \"command\": \"echo START_STACK_CLEAN_AND_BUILD && cd ${workspaceRoot} && stack clean && stack build && echo END_STACK_CLEAN_AND_BUILD \"" , " }," , " { "- , " \"isTestCommand\": true,"- , " \"taskName\": \"stack test\","- , " \"args\": [ \"echo START_STACK_TEST && cd ${workspaceRoot} && stack test && echo END_STACK_TEST \" ]"+ , " \"group\": {"+ , " \"kind\": \"test\","+ , " \"isDefault\": true"+ , " },"+ , " \"type\": \"shell\","+ , " \"label\": \"stack test\","+ , " \"command\": \"echo START_STACK_TEST && cd ${workspaceRoot} && stack test && echo END_STACK_TEST \"" , " }," , " { "- , " \"isBackground\": true,"- , " \"taskName\": \"stack watch\","- , " \"args\": [ \"echo START_STACK_WATCH && cd ${workspaceRoot} && stack build --test --no-run-tests --file-watch && echo END_STACK_WATCH \" ]"+ , " \"isBackground\": true,"+ , " \"type\": \"shell\","+ , " \"label\": \"stack watch\","+ , " \"command\": \"echo START_STACK_WATCH && cd ${workspaceRoot} && stack build --test --no-run-tests --file-watch && echo END_STACK_WATCH \"" , " }" , " ]" , "}"@@ -272,8 +281,9 @@ _NEW_VERSION_MSG = [ "" , " New hackage module has been released."- , " `stack update` and install new phoityen-vscode."+ , " `stack update` and `stack install phoityen-vscode`." , " "+ , " " ] @@ -308,6 +318,7 @@ , responseHandlerDebugContextData = BSL.putStr , stopOnEntryDebugContextData = False , hackagePackageVersionDebugContextData = ""+ , haskellDapEnabledDebugContextData = False } @@ -485,7 +496,9 @@ Left err -> sendParseErrorAndTerminate err "scopes" handle "variables" = case J.eitherDecode jsonStr :: Either String J.VariablesRequest of- Right req -> variablesRequestHandler mvarDat req+ Right req -> haskellDapEnabledDebugContextData <$> (readMVar mvarDat) >>= \case+ True -> variablesRequestHandlerDAP mvarDat req+ False -> variablesRequestHandler mvarDat req Left err -> sendParseErrorAndTerminate err "variables" handle "threads" = case J.eitherDecode jsonStr :: Either String J.ThreadsRequest of@@ -584,6 +597,7 @@ , startupFuncDebugContextData = maybe "" (\s->if null (U.strip s) then "" else (U.strip s)) (J.startupFuncLaunchRequestArguments args) , startupArgsDebugContextData = maybe "" (id) (J.startupArgsLaunchRequestArguments args) , stopOnEntryDebugContextData = J.stopOnEntryLaunchRequestArguments args+ , haskellDapEnabledDebugContextData = L.isInfixOf _HASKELL_DAP_EXE (J.ghciCmdLaunchRequestArguments args) } let logLevelStr = J.logLevelLaunchRequestArguments args@@ -765,7 +779,24 @@ -- | -- setBreakpointsRequestHandler :: MVar DebugContextData -> J.SetBreakpointsRequest -> IO ()-setBreakpointsRequestHandler mvarCtx req = flip E.catches handlers $ do+setBreakpointsRequestHandler mvarCtx req = do+ ctx <- readMVar mvarCtx+ let cwd = workspaceDebugContextData ctx+ args = J.argumentsSetBreakpointsRequest req+ source = J.sourceSetBreakpointsRequestArguments args+ path = J.pathSource source++ if U.startswith cwd path then setBreakpointsInternal mvarCtx req + else do+ let msg = L.intercalate " " ["setBreakpoints request ignored."]+ resSeq <- getIncreasedResponseSequence mvarCtx+ sendResponse mvarCtx $ J.encode $ J.errorSetBreakpointsResponse resSeq req msg +++-- |+--+setBreakpointsInternal :: MVar DebugContextData -> J.SetBreakpointsRequest -> IO ()+setBreakpointsInternal mvarCtx req = flip E.catches handlers $ do logRequest $ show req ctx <- readMVar mvarCtx@@ -1237,14 +1268,104 @@ Right dats -> return $ map convBind2Vals dats - convBind2Vals (G.BindingData varName modName val) = J.Variable varName modName val (Just varName) 0+ convBind2Vals (G.BindingData varName modName val) =+ J.Variable {+ J.nameVariable = varName+ , J.typeVariable = modName+ , J.valueVariable = val+ , J.evaluateNameVariable = (Just varName)+ , J.variablesReferenceVariable = 0+ , J.presentationHintVariable = Nothing+ , J.namedVariablesVariable = Nothing+ , J.indexedVariablesVariable = Nothing+ } outHdl = debugM _LOG_NAME +-- |+--+--+variablesRequestHandlerDAP :: MVar DebugContextData -> J.VariablesRequest -> IO ()+variablesRequestHandlerDAP mvarCtx req = flip E.catches handlers $ do+ logRequest $ show req + vals <- currentBindings++ resSeq <- getIncreasedResponseSequence mvarCtx+ let res = J.defaultVariablesResponse resSeq req+ resStr = J.encode $ res{J.bodyVariablesResponse = J.VariablesBody vals}+ sendResponse mvarCtx resStr++ where+ handlers = [ E.Handler someExcept ]+ someExcept (e :: E.SomeException) = do+ let msg = L.intercalate " " ["variables request error.", show req, show e]+ resSeq <- getIncreasedResponseSequence mvarCtx+ sendResponse mvarCtx $ J.encode $ J.errorVariablesResponse resSeq req msg + sendErrorEvent mvarCtx msg++ currentBindings = ghciProcessDebugContextData <$> (readMVar mvarCtx) >>= withProcess++ withProcess Nothing = do+ sendErrorEvent mvarCtx "[variablesRequestHandler] ghci not started."+ return []++ withProcess (Just ghciProc) = do+ let args = J.argumentsVariablesRequest req+ idx = J.variablesReferenceVariablesArguments args+ + G.bindingsDAP ghciProc outHdl idx >>= \case+ Left err -> do+ sendErrorEvent mvarCtx $ show err+ return []++ Right dats -> case readMay dats of+ Just vals -> do+ debugM _LOG_NAME $ "[variablesRequestHandlerDAP] read string: " ++ dats+ return vals+ Nothing -> do+ sendErrorEvent mvarCtx $ "[variablesRequestHandler] can not read valriables. " ++ dats+ return []++ outHdl = debugM _LOG_NAME++ -- | --+{-+variablesRequestHandlerDAP :: MVar DebugContextData -> BSL.ByteString -> IO ()+variablesRequestHandlerDAP mvarCtx jsonStr = flip E.catches handlers $ do+ logRequest $ show jsonStr++ resStr <- currentBindings+ -- {"seq":36,"type":"response","request_seq":11,"success":true,"command":"variables","message":"","body":{"variables":[{"name":"foo","type":"Foo","value":"_","evaluateName":"foo","variablesReference":0},{"name":"_result","type":"IO ()","value":"_","evaluateName":"_result","variablesReference":0}]}}+ sendResponse mvarCtx resStr++ where+ handlers = [ E.Handler someExcept ]+ someExcept (e :: E.SomeException) = do+ let msg = L.intercalate " " ["[variablesRequestHandlerDAP] variables request error.", show e]+ sendErrorEvent mvarCtx msg++ currentBindings = ghciProcessDebugContextData <$> (readMVar mvarCtx) >>= withProcess++ withProcess Nothing = do+ sendErrorEvent mvarCtx "[variablesRequestHandlerDAP] ghci not started."+ return $ "[variablesRequestHandlerDAP] CRITICAL."++ withProcess (Just ghciProc) = G.dap ghciProc outHdl (lbs2str jsonStr) >>= \case+ Left err -> do+ sendErrorEvent mvarCtx $ show err+ return $ "[variablesRequestHandlerDAP] CRITICAL."++ Right dats -> return (str2lbs dats)++ outHdl = debugM _LOG_NAME+-}++-- | --+-- threadsRequestHandler :: MVar DebugContextData -> J.ThreadsRequest -> IO () threadsRequestHandler mvarCtx req = flip E.catches handlers $ do logRequest $ show req@@ -1288,7 +1409,7 @@ evaluateResponse err "" Right typeStr -> case isFunction typeStr of - True -> evaluateResponse "" (getOnlyType typeStr)+ True -> evaluateResponse ("function :: " ++ (getOnlyType typeStr)) (getOnlyType typeStr) False -> G.force ghciProc outHdl exp >>= \case Right valStr -> evaluateResponse (getOnlyValue valStr) (getOnlyType typeStr) Left _ -> evaluateResponse "" (getOnlyType typeStr)
app/Phoityne/VSCode/TH/VariableJSON.hs view
@@ -7,17 +7,21 @@ import Phoityne.VSCode.Utility +import Phoityne.VSCode.TH.VariablePresentationHintJSON -- | -- A Variable is a name/value pair. -- If the value is structured (has children), a handle is provided to retrieve the children with the VariablesRequest. -- data Variable = Variable {- nameVariable :: String -- The variable's name- , typeVariable :: String -- he variable's type.- , valueVariable :: String -- The variable's value. For structured objects this can be a multi line text, e.g. for a function the body of a function.+ nameVariable :: String -- The variable's name.+ , valueVariable :: String -- The variable's value. This can be a multi-line text, e.g. for a function the body of a function.+ , typeVariable :: String -- The type of the variable's value. Typically shown in the UI when hovering over the value.+ , presentationHintVariable :: Maybe VariablePresentationHint -- Properties of a variable that can be used to determine how to render the variable in the UI. , evaluateNameVariable :: Maybe String -- Optional evaluatable name of this variable which can be passed to the 'EvaluateRequest' to fetch the variable's value. , variablesReferenceVariable :: Int -- If variablesReference is > 0, the variable is structured and its children can be retrieved by passing variablesReference to the VariablesRequest.+ , namedVariablesVariable :: Maybe Int -- The number of named child variables.+ , indexedVariablesVariable :: Maybe Int -- The number of indexed child variables. The client can use this optional information to present the children in a paged UI and fetch them in chunks. } deriving (Show, Read, Eq)
+ app/Phoityne/VSCode/TH/VariablePresentationHintJSON.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE TemplateHaskell #-} + + +module Phoityne.VSCode.TH.VariablePresentationHintJSON where + +import Data.Aeson.TH + +import Phoityne.VSCode.Utility + +-- | +-- Optional properties of a variable that can be used to determine how to render the variable in the UI. +-- +data VariablePresentationHint = + VariablePresentationHint { + {- + The kind of variable. Before introducing additional values, try to use the listed values. + Values: + 'property': Indicates that the object is a property. + 'method': Indicates that the object is a method. + 'class': Indicates that the object is a class. + 'data': Indicates that the object is data. + 'event': Indicates that the object is an event. + 'baseClass': Indicates that the object is a base class. + 'innerClass': Indicates that the object is an inner class. + 'interface': Indicates that the object is an interface. + 'mostDerivedClass': Indicates that the object is the most derived class. + 'virtual': Indicates that the object is virtual, that means it is a synthetic object introduced by the adapter for rendering purposes, e.g. an index range for large arrays. + etc. + -} + kindVariablePresentationHint :: String + {- + Set of attributes represented as an array of strings. Before introducing additional values, try to use the listed values. + Values: + 'static': Indicates that the object is static. + 'constant': Indicates that the object is a constant. + 'readOnly': Indicates that the object is read only. + 'rawString': Indicates that the object is a raw string. + 'hasObjectId': Indicates that the object can have an Object ID created for it. + 'canHaveObjectId': Indicates that the object has an Object ID associated with it. + 'hasSideEffects': Indicates that the evaluation had side effects. + etc. + -} + , attributesVariablePresentationHint :: [String] + {- + Visibility of variable. Before introducing additional values, try to use the listed values. + Values: 'public', 'private', 'protected', 'internal', 'final', etc. + -} + , visibilityVariablePresentationHint :: String + } deriving (Show, Read, Eq) + + +$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "VariablePresentationHint") } ''VariablePresentationHint) + +-- | +-- +defaultVariablePresentationHint :: VariablePresentationHint +defaultVariablePresentationHint = VariablePresentationHint "data" [] "public" +
phoityne-vscode.cabal view
@@ -1,5 +1,5 @@ name: phoityne-vscode-version: 0.0.18.0+version: 0.0.19.0 synopsis: ghci debug viewer on Visual Studio Code description: Please see README.md license: BSD3@@ -111,6 +111,7 @@ , Phoityne.VSCode.TH.ThreadsResponseBodyJSON , Phoityne.VSCode.TH.ThreadsResponseJSON , Phoityne.VSCode.TH.VariableJSON+ , Phoityne.VSCode.TH.VariablePresentationHintJSON , Phoityne.VSCode.TH.VariablesArgumentsJSON , Phoityne.VSCode.TH.VariablesBodyJSON , Phoityne.VSCode.TH.VariablesRequestJSON