packages feed

phoityne-vscode (empty) → 0.0.1.0

raw patch · 89 files changed

+4280/−0 lines, 89 filesdep +Cabaldep +ConfigFiledep +HStringTemplatesetup-changed

Dependencies added: Cabal, ConfigFile, HStringTemplate, MissingH, aeson, base, bytestring, cmdargs, conduit, conduit-extra, containers, directory, filepath, hslogger, hspec, mtl, parsec, process, resourcet, safe, split, text, transformers

Files

+ Changelog.md view
@@ -0,0 +1,6 @@++20160504 phoityne-vscode-0.0.1.0++  * [Info] Initial release.++
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,51 @@+++# Phoityne VSCode++Phoityne is a ghci debug viewer for Visual Studio Code. (on Windows)+++## Debug on VSCode++1. Start VSCode+2. Open stack project folder+3. Open debug view+4. Open launch.json+5. Set startup source file. Default file is test/Spec.hs+6. Run debug(F5)++![Document](https://sites.google.com/site/phoityne/doc_jp/demo01.gif?attredirects=0)+++## Install+++### Run stack install++    % stack new project+      . . . . .+    %+    % cd project+    % stack install phoityne-vscode+      . . . . .+    %+++### Prepare vscode extensions++1. create folder "%USERPROFILE%\.vscode\extensions\phoityne-vscode"+2. copy "phoityne-vscode-0.0.1.0\vscode\package.json"(*) to "%USERPROFILE%\.vscode\extensions\phoityne-vscode"+3. copy "%USERPROFILE%\AppData\Roaming\local\bin\phoityne-vscode.exe" to "%USERPROFILE%\.vscode\extensions\phoityne-vscode"++(*) download by stack unpack.++    % stack unpack phoityne-vscode+    %+++## Important++* need c:\temp folder. phoityne.log file will be created.+* breakpoint can be set in a .hs file which defineds "module ... where".+* source file extension must be ".hs"+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++-- モジュール+import qualified Phoityne.IO.Main as M++-- システム+import System.Exit++-- |+--  メイン+--+main :: IO ()+main = do+  M.run >>= \case+    0 -> exitSuccess+    c -> exitWith . ExitFailure $ c+
+ app/Phoityne/Argument.hs view
@@ -0,0 +1,121 @@+{-# LANGUAGE GADTs               #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE DeriveDataTypeable  #-}+{-# OPTIONS_GHC -fno-cse         #-}++module Phoityne.Argument (+  HelpExitException(..)+, ArgData(..)+, config+) where++-- システム+import System.Console.CmdArgs+import qualified Control.Exception as E++-- |+--  ヘルプ表示時の例外+--+data HelpExitException = HelpExitException+                       deriving (Show, Typeable)++instance E.Exception HelpExitException++-- |+--  コマンドライン引数データ設定+--    モードを使用する場合のサンプル+--+data ArgData = ModeA+             {+               file   :: String+             , method :: Method+             }+             | ModeB+             {+               file  :: String+             , value :: Int+             } deriving (Data, Typeable, Show, Read, Eq)++-- |+--  アノテーション設定+--+config :: ArgData+config = modes [confA, confB]+         &= summary sumMsg+         &= program "prj-tpl"+         +  where+    confA = ModeA {+            file = def+             &= name "f"+             &= name "file"+             &= explicit+             &= typFile+             &= help "ini file"+          , method = enum+                   [+                     Get+                       &= name "get"+                       &= explicit+                       &= help "method type Get"+                   , Post+                       &= name "post"+                       &= explicit+                       &= help "  | type Post"+                   , Put+                       &= name "put"+                       &= explicit+                       &= help "  | type Put"+                   , Delete+                       &= name "delete"+                       &= explicit+                       &= help "  | type Delete"+                   ]+          } &= name "ModeA"+            &= details mdAMsg+            &= auto+    confB = ModeB {+            file = def+             &= name "f"+             &= name "file"+             &= explicit+             &= typFile+             &= help "ini file"+          , value = def+             &= name "value"+             &= explicit+             &= help "integer value"+          } &= name "ModeB"+            &= details mdBMsg++    sumMsg = unlines [+             ""+           , "  ☆ サマリ説明 ☆"+           , ""+           , "     ここに簡単な説明を記載する。"+           , ""+           ]+           +    mdAMsg = [+             ""+           , "  ★ 詳細説明 ★"+           , ""+           , "     ここにModeAの詳細な説明を記載する。"+           , ""+           ]++    mdBMsg = [+             ""+           , "  ★ 詳細説明 ★"+           , ""+           , "     ここにModeBの詳細な説明を記載する。"+           , ""+           ]++-- |+--  enum値引数+--+data Method = Get | Post | Put | Delete+              deriving (Data, Typeable, Show, Read, Eq)++
+ app/Phoityne/Constant.hs view
@@ -0,0 +1,74 @@++module Phoityne.Constant where++-- |+--+--+_INI_SEC_LOG :: String+_INI_SEC_LOG   = "LOG"++_INI_LOG_FILE :: String+_INI_LOG_FILE  = "file"++_INI_LOG_LEVEL :: String+_INI_LOG_LEVEL = "level"++_INI_SEC_PHOITYNE :: String+_INI_SEC_PHOITYNE = "PHOITYNE"+++-- |+--+--+_LOG_NAME :: String+_LOG_NAME = "phoityne"++_LOG_FORMAT :: String+_LOG_FORMAT = "$time [$tid] $prio $loggername - $msg"++_LOG_FORMAT_DATE :: String+_LOG_FORMAT_DATE = "%Y-%m-%d %H:%M:%S"+++-- |+--+--+type ModuleName = String++_HS_FILE_EXT :: String+_HS_FILE_EXT = ".hs"++_PHOITYNE_GHCI_PROMPT :: String+_PHOITYNE_GHCI_PROMPT = "Phoityne>>= "++_GHCI_PROMPT :: String+_GHCI_PROMPT = "Prelude> "++_GHCI_MAIN_PROMPT :: String+_GHCI_MAIN_PROMPT = "*Main> "++_PROJECT_ROOT_MODULE_NAME :: String+_PROJECT_ROOT_MODULE_NAME = "Project Root"++_INDENT_SPACE :: String+_INDENT_SPACE = "  "++_COMMENT_TAG :: String+_COMMENT_TAG = "-- "++_UNDO_BUFFER_MAX_SIZE :: Int+_UNDO_BUFFER_MAX_SIZE = 100++_AVAILABLE_FILE_EXT :: [String]+_AVAILABLE_FILE_EXT = [ ".hs"+                      , ".ini"+                      , ".yaml"+                      , ".cabal"+                      ]++-- |+--+--+_NO_BREAK_POINT_LOCATION :: String+_NO_BREAK_POINT_LOCATION = "No breakpoints found at that location."+
+ app/Phoityne/IO/CUI/GHCiControl.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE GADTs               #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE MultiWayIf          #-}+{-# LANGUAGE BinaryLiterals      #-}+{-# LANGUAGE TemplateHaskell     #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable  #-}++module Phoityne.IO.CUI.GHCiControl where++-- モジュール+import Phoityne.Constant+import Phoityne.IO.Utility++-- システム+import System.Process+import System.IO+import System.Exit+import System.Log.Logger+import qualified Control.Exception as E+import qualified Data.List as L++-- |+--+--+data ExternalCommandData = ExternalCommandData+  {+    inExternalCommandData   :: Maybe Handle+  , outExternalCommandData  :: Maybe Handle+  , errExternalCommandData  :: Maybe Handle+  , procExternalCommandData :: Maybe ProcessHandle+  }+++-- |+--+--+defaultExternalCommandData :: ExternalCommandData+defaultExternalCommandData = ExternalCommandData Nothing Nothing Nothing Nothing+++-- |+--+--+run :: String -> [String] -> Maybe FilePath -> IO ExternalCommandData+run cmd opts curDir = flip E.catches handlers $ do++  debugM _LOG_NAME "run external command."++  (fromHaskellHandle, toExternalHandle) <- createPipe+  (fromExternalHandle, toHaskellHandle) <- createPipe++  osEnc <- getReadHandleEncoding++  hSetBuffering toHaskellHandle NoBuffering+  hSetEncoding toHaskellHandle  osEnc++  hSetBuffering fromHaskellHandle NoBuffering+  hSetEncoding fromHaskellHandle  utf8++  hSetBuffering toExternalHandle NoBuffering+  hSetEncoding toExternalHandle utf8++  hSetBuffering fromExternalHandle NoBuffering+  hSetEncoding fromExternalHandle  osEnc+++  debugM _LOG_NAME $ "external command : " ++ cmd ++ " " ++ (L.intercalate " " opts)+  ghciProc <- runProcess cmd opts curDir Nothing (Just fromHaskellHandle) (Just toHaskellHandle) (Just toHaskellHandle)++  return $ ExternalCommandData (Just toExternalHandle) (Just fromExternalHandle) (Just fromExternalHandle) (Just ghciProc)++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      criticalM _LOG_NAME ("run:" ++ show e)+      return $ ExternalCommandData Nothing Nothing Nothing Nothing++-- |+--+--+waitExit :: ExternalCommandData -> IO ExitCode+waitExit (ExternalCommandData _ _ _ (Just ghciProc)) = flip E.catches handlers $ do+  waitForProcess ghciProc+  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      criticalM _LOG_NAME ("waitExit:" ++ show e)+      return $ ExitFailure 2+waitExit _ = do+  criticalM _LOG_NAME "waitExit"+  return $ ExitFailure 2+++-- |+--+--+writeLine :: ExternalCommandData -> String -> IO ()+writeLine (ExternalCommandData (Just ghciIn) _ _ _) cmd = flip E.catches handlers $ hIsOpen ghciIn >>= \case+  False -> criticalM _LOG_NAME "[writeLine] handle not open."+  True  -> debugM _LOG_NAME ("[writeLine]" ++ cmd) >> hPutStrLn ghciIn cmd+  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = criticalM _LOG_NAME ("writeLine:" ++ show e)++writeLine _ _ = criticalM _LOG_NAME "[writeLine] handle is nothing."+++-- |+--+--+readWhile :: ExternalCommandData -> (String -> Bool) -> IO String+readWhile (ExternalCommandData _ (Just ghciOut) _ _) proc = flip E.catches handlers $ go []+  where+    go acc = hIsEOF ghciOut >>= \case+      True -> return acc+      False -> do+        c <- hGetChar ghciOut+        let acc' = acc ++ [c]+        if proc acc' then go acc'+          else return acc'++    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = criticalM _LOG_NAME ("readWhile:" ++ show e) >> return ""++readWhile _ _ = criticalM _LOG_NAME "readWhile" >> return ""+++-- |+--+--+readLineWhileIO :: ExternalCommandData -> ([String] -> IO Bool) -> IO [String]+readLineWhileIO (ExternalCommandData _ (Just ghciOut) _ _) proc = flip E.catches handlers $ go []+  where+    go acc = hIsEOF ghciOut >>= \case+      True -> return acc+      False -> do+        l <- hGetLine ghciOut+        let acc' = acc ++ [l]+        proc acc' >>= \case+          True  -> go acc'+          False -> return acc'++    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = criticalM _LOG_NAME ("readLineWhileIO:" ++ show e) >> return []++readLineWhileIO _ _ = criticalM _LOG_NAME "readLineWhileIO" >> return []+
+ app/Phoityne/IO/Control.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE GADTs               #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE MultiWayIf          #-}+{-# LANGUAGE BinaryLiterals      #-}+{-# LANGUAGE TemplateHaskell     #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable  #-}++module Phoityne.IO.Control where++-- モジュール+import Phoityne.Constant+import qualified Phoityne.Argument as A+import qualified Phoityne.IO.GUI.Control as GUI+import qualified Phoityne.IO.CUI.GHCiControl as GHCI++-- システム+import System.Info+import System.Log.Logger+import System.Exit+import Distribution.System+import Control.Concurrent+import Data.String.Utils+import qualified Data.ConfigFile as C++-- |+--  ロジックメイン+-- +run :: A.ArgData      -- コマンドライン引数+    -> C.ConfigParser -- INI設定+    -> IO Int         -- exit code+run _ _ = do++  infoM _LOG_NAME $ "OS:" ++ os+  infoM _LOG_NAME $ "ARCH:" ++ arch+  infoM _LOG_NAME $ "BuildOS:" ++ show buildOS++  mvarCUI <- newMVar GHCI.defaultExternalCommandData++  let cmdData = createCmdData mvarCUI++  GUI.run cmdData++  return 1+++  where+    createCmdData mvarCUI =+      GUI.DebugCommandData {+        GUI.startDebugCommandData        = debugStart mvarCUI+      , GUI.stopDebugCommandData         = stopDebug mvarCUI+      , GUI.readDebugCommandData         = readResult mvarCUI+      , GUI.readLinesDebugCommandData    = readLines mvarCUI+      , GUI.promptDebugCommandData       = execCmd mvarCUI $ ":set prompt \"" ++ _PHOITYNE_GHCI_PROMPT ++ "\""+      , GUI.breakDebugCommandData        = setBreak mvarCUI+      , GUI.bindingsDebugCommandData     = execCmd mvarCUI ":show bindings"+      , GUI.runDebugCommandData          = runDebug mvarCUI+      , GUI.continueDebugCommandData     = continueCmd mvarCUI+      , GUI.stepDebugCommandData         = execCmd mvarCUI ":step"+      , GUI.stepOverDebugCommandData     = execCmd mvarCUI ":steplocal"+      , GUI.printEvldDebugCommandData    = execCmd mvarCUI ":set -fprint-evld-with-show"+      , GUI.deleteBreakDebugCommandData  = \n -> execCmd mvarCUI $ ":delete " ++ show n+      , GUI.traceHistDebugCommandData    = execCmd mvarCUI ":history"+      , GUI.traceBackDebugCommandData    = execCmd mvarCUI ":back"+      , GUI.traceForwardDebugCommandData = execCmd mvarCUI ":forward"+      , GUI.forceDebugCommandData        = \arg -> execCmd mvarCUI $ ":force " ++ arg+      , GUI.execCommandData              = execCmd mvarCUI+      , GUI.quitDebugCommandData         = execCmd mvarCUI ":quit"+      , GUI.buildStartDebugCommandData   = buildStart mvarCUI+      , GUI.cleanStartDebugCommandData   = cleanStart mvarCUI+      , GUI.loadFileDebugCommandData     = \f-> execCmd mvarCUI $ ":l " ++ f+      , GUI.readWhileDebugCommandData    = readWhile mvarCUI+      , GUI.infoDebugCommandData         = \arg -> execCmd mvarCUI $ ":info " ++ arg+      }+++-- |+--+-- +cleanStart :: MVar GHCI.ExternalCommandData -> FilePath -> IO ()+cleanStart mvarCUI cwd = do+  exeData <- GHCI.run "stack" ["clean"] $ Just cwd+  takeMVar mvarCUI >> putMVar mvarCUI exeData++-- |+--+-- +debugStart :: MVar GHCI.ExternalCommandData -> FilePath -> IO ()+debugStart mvarCUI cwd = do+  exeData <- GHCI.run "stack" ["ghci", "--test", "--no-build", "--no-load"] $ Just cwd+  takeMVar mvarCUI >> putMVar mvarCUI exeData+++-- |+--+-- +buildStart :: MVar GHCI.ExternalCommandData -> FilePath -> IO ()+buildStart mvarCUI cwd = do+  exeData <- GHCI.run "stack" ["build", "--test", "--no-run-tests"] $ Just cwd+  takeMVar mvarCUI >> putMVar mvarCUI exeData+++-- |+--+-- +setBreak :: MVar GHCI.ExternalCommandData+         -> String -- module name+         -> Int    -- linen no+         -> IO String+setBreak mvarCUI modName lineNo = do+  let cmd = ":break " ++ modName ++ " " ++ show lineNo+  execCmd mvarCUI cmd+++-- |+--+-- +runDebug :: MVar GHCI.ExternalCommandData -> Bool -> IO String+runDebug mvarCUI isTrace = do+  let cmd = if isTrace then ":trace main" else "main"+  execCmd mvarCUI cmd+++-- |+--+-- +readResult :: MVar GHCI.ExternalCommandData -> IO String+readResult mvarCUI = readWhile mvarCUI $ not . endswith _PHOITYNE_GHCI_PROMPT+++-- |+--+-- +readWhile :: MVar GHCI.ExternalCommandData -> (String -> Bool) -> IO String+readWhile mvarCUI proc = do+  exeData <- readMVar mvarCUI+  GHCI.readWhile exeData proc+++-- |+--+-- +readLines :: MVar GHCI.ExternalCommandData -> ([String] -> IO Bool) -> IO [String]+readLines mvarCUI proc = do+  exeData <- readMVar mvarCUI+  GHCI.readLineWhileIO exeData proc+++-- |+--+--+stopDebug :: MVar GHCI.ExternalCommandData -> IO ExitCode+stopDebug mvarCUI = do+  exeData <- readMVar mvarCUI+  GHCI.waitExit exeData+++-- |+--+--+continueCmd :: MVar GHCI.ExternalCommandData -> Bool -> IO String+continueCmd mvarCUI isTrace = do+  let cmd = if isTrace then ":trace" else ":continue"+  execCmd mvarCUI cmd+++-- |+--+--+execCmd :: MVar GHCI.ExternalCommandData -> String -> IO String+execCmd mvarCUI cmd = do+  exeData <- readMVar mvarCUI+  GHCI.writeLine exeData cmd+  return cmd
+ app/Phoityne/IO/GUI/Control.hs view
@@ -0,0 +1,1352 @@+{-# LANGUAGE GADTs               #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE MultiWayIf          #-}+{-# LANGUAGE BinaryLiterals      #-}+{-# LANGUAGE TemplateHaskell     #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable  #-}++module Phoityne.IO.GUI.Control (+  run+, DebugCommandData(..)+) where++import Phoityne.Constant+import Phoityne.Utility++import qualified Phoityne.IO.GUI.VSCode.TH.BreakpointJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.ContinueRequestJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.ContinueResponseJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.DisconnectRequestJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.DisconnectResponseJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.EvaluateArgumentsJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.EvaluateBodyJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.EvaluateRequestJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.EvaluateResponseJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.InitializedEventJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.InitializeRequestJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.InitializeResponseCapabilitesJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.InitializeResponseJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.LaunchRequestArgumentsJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.LaunchRequestJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.LaunchResponseJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.NextRequestJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.NextResponseJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.OutputEventJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.OutputEventBodyJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.PauseRequestJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.PauseResponseJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.RequestJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.ScopesArgumentsJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.ScopesRequestJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.ScopesResponseJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.SetBreakpointsRequestArgumentsJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.SetBreakpointsRequestJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.SetBreakpointsResponseBodyJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.SetBreakpointsResponseJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.SourceBreakpointJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.SourceJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.SourceRequestJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.SourceResponseJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.StackFrameJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.StackTraceBodyJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.StackTraceRequestJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.StackTraceResponseJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.StepInRequestJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.StepInResponseJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.StepOutRequestJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.StepOutResponseJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.StoppedEventJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.TerminatedEventJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.ThreadsRequestJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.ThreadsResponseJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.VariableJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.VariablesBodyJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.VariablesRequestJSON as J+import qualified Phoityne.IO.GUI.VSCode.TH.VariablesResponseJSON as J++import System.IO+import System.Exit+import System.FilePath+import System.Log.Logger+import qualified Data.Aeson as J+import qualified Data.ByteString.Lazy as BSL+import Text.Parsec+import Data.String.Utils+import qualified Data.List as L+import qualified Control.Exception as E+import qualified Data.Map as MAP+import Control.Concurrent+import Data.List.Split+import Data.Char+import Data.Maybe+import Data.Functor.Identity+import Control.Monad++++-- |+--+--+data DebugContext = +  DebugContext {+    resSeqDebugContext          :: Int+  , breakPointDatasDebugContext :: BreakPointDatas+  , workspaceDebugContext       :: FilePath+  , startupDebugContext         :: FilePath+  , debugStartedDebugContext    :: Bool+  , debugStoppedPosDebugContext :: Maybe HighlightTextRangeData+  , currentFrameIdDebugContext  :: Int+  } deriving (Show, Read, Eq, Ord)++++-- |+--+--+data DebugCommandData =+  DebugCommandData {+    startDebugCommandData        :: FilePath ->  IO ()+  , stopDebugCommandData         :: IO ExitCode+  , readDebugCommandData         :: IO String+  , readLinesDebugCommandData    :: ([String] -> IO Bool) -> IO [String]+  , promptDebugCommandData       :: IO String+  , breakDebugCommandData        :: ModuleName -> Int -> IO String+  , bindingsDebugCommandData     :: IO String+  , runDebugCommandData          :: Bool -> IO String+  , continueDebugCommandData     :: Bool -> IO String+  , stepDebugCommandData         :: IO String+  , stepOverDebugCommandData     :: IO String+  , printEvldDebugCommandData    :: IO String +  , deleteBreakDebugCommandData  :: Int -> IO String+  , traceHistDebugCommandData    :: IO String+  , traceBackDebugCommandData    :: IO String+  , traceForwardDebugCommandData :: IO String+  , forceDebugCommandData        :: String -> IO String+  , execCommandData              :: String -> IO String+  , quitDebugCommandData         :: IO String+  , buildStartDebugCommandData   :: FilePath -> IO ()+  , cleanStartDebugCommandData   :: FilePath -> IO ()+  , loadFileDebugCommandData     :: FilePath -> IO String+  , readWhileDebugCommandData    :: (String -> Bool) -> IO String+  , infoDebugCommandData         :: String -> IO String+  }++-- |+--+--+data HighlightTextRangeData = HighlightTextRangeData {+    filePathHighlightTextRangeData    :: FilePath+  , startLineNoHighlightTextRangeData :: Int+  , startColNoHighlightTextRangeData  :: Int+  , endLineNoHighlightTextRangeData   :: Int+  , endColNoHighlightTextRangeData    :: Int+  } deriving (Show, Read, Eq, Ord)+++-- |+--  +-- +data BreakPointData =+  BreakPointData {+    moduleNameBreakPointData :: String+  , filePathBreakPointData   :: FilePath+  , lineNoBreakPointData     :: Int+  , breakNoBreakPointData    :: Maybe Int+  , conditionBreakPointData  :: Maybe String+  } deriving (Show, Read, Eq, Ord)++-- |+--  +-- +data TraceData = TraceData {+    traceIdTraceData  :: String+  , functionTraceData :: String+  , filePathTraceData :: String+  } deriving (Show, Read, Eq, Ord)++-- |+--  +-- +data BindingData = BindingData {+    varNameBindingData :: String+  , modNameBindingData :: String+  , valueBindingData :: String+  } deriving (Show, Read, Eq, Ord)++-- |+--  +-- +type BreakPointDataKey = (FilePath, Int)+type BreakPointDatas = MAP.Map BreakPointDataKey BreakPointData+++-- |+--+--+_INITIAL_RESPONSE_SEQUENCE :: Int+_INITIAL_RESPONSE_SEQUENCE = 0+++-- |+--+--+_TWO_CRLF :: String+_TWO_CRLF = "\r\n\r\n"+++-- |+--+--+_SEP_WIN :: Char+_SEP_WIN = '\\'++_SEP_UNIX :: Char+_SEP_UNIX = '/'+++-- |+--+--+defaultDebugContext :: DebugContext+defaultDebugContext = DebugContext _INITIAL_RESPONSE_SEQUENCE (MAP.fromList []) "" "" False Nothing 0+++-- |+--+--+run :: DebugCommandData -> IO ()+run cmdData = do++  hSetBuffering stdin NoBuffering+  hSetEncoding  stdin utf8++  hSetBuffering stdout NoBuffering+  hSetEncoding  stdout utf8++  mvarCtx <- newMVar defaultDebugContext++  wait cmdData mvarCtx+++-- |+--+-- +wait :: DebugCommandData -> MVar DebugContext -> IO ()+wait cmdData ctx = go BSL.empty+  where+    go :: BSL.ByteString -> IO ()+    go buf = do+      c <- BSL.hGet stdin 1+      let newBuf = BSL.append buf c+      case readContentLength (lbs2str newBuf) of+        Left _ -> go newBuf+        Right len -> do+          infoM _LOG_NAME $ "[REQUEST] Content-Length: " ++ show len+          cnt <- BSL.hGet stdin len+          infoM _LOG_NAME $ "[REQUEST] " ++ lbs2str cnt+          handleRequest cmdData ctx cnt+    +      where+        readContentLength :: String -> Either ParseError Int+        readContentLength = parse parser "readContentLength"+    +        parser = do+          string "Content-Length: "+          len <- manyTill digit (string _TWO_CRLF)+          return . read $ len++-- |+--+--+handleRequest :: DebugCommandData -> MVar DebugContext -> BSL.ByteString -> IO ()+handleRequest cmdData mvarCtx jsonStr = case J.eitherDecode  jsonStr :: Either String J.Request of+  Left  err     -> errRes jsonStr $ "requet parse error. [" ++ err ++ "]" +  Right jsonDat -> sucRes jsonStr jsonDat++  where+    errRes :: BSL.ByteString -> String -> IO ()+    errRes jsonStr msg = do+      errorM _LOG_NAME $ msg ++ " [" ++ lbs2str jsonStr ++ "]"+      wait cmdData mvarCtx++    sucRes jsonStr (J.Request cmd) = do+      handle jsonStr cmd+      wait cmdData mvarCtx++    handle jsonStr "initialize" = case J.eitherDecode jsonStr :: Either String J.InitializeRequest of+      Left  err -> errRes jsonStr $ "initialize parse error. [" ++ err ++ "]" +      Right req -> initializeHandler mvarCtx req+++    handle jsonStr "launch" = case J.eitherDecode jsonStr :: Either String J.LaunchRequest of+      Left  err -> errRes jsonStr $ "launch parse error. [" ++ err ++ "]" +      Right req -> launchHandler cmdData mvarCtx req+++    handle jsonStr "disconnect" = case J.eitherDecode jsonStr :: Either String J.DisconnectRequest of+      Left  err -> errRes jsonStr $ "disconnect parse error. [" ++ err ++ "]" +      Right req -> disconnectHandler cmdData mvarCtx req+++    handle jsonStr "setBreakpoints" = case J.eitherDecode jsonStr :: Either String J.SetBreakpointsRequest of+      Left  err -> errRes jsonStr $ "setBreakpoints parse error. [" ++ err ++ "]" +      Right req -> setBreakpointsHandler cmdData mvarCtx req+++    handle jsonStr "continue" = case J.eitherDecode jsonStr :: Either String J.ContinueRequest of+      Left  err -> errRes jsonStr $ "continue parse error. [" ++ err ++ "]" +      Right req -> continueHandler cmdData mvarCtx req+++    handle jsonStr "next" = case J.eitherDecode jsonStr :: Either String J.NextRequest of+      Left  err -> errRes jsonStr $ "next parse error. [" ++ err ++ "]" +      Right req -> stepOverHandler cmdData mvarCtx req+++    handle jsonStr "stepIn" = case J.eitherDecode jsonStr :: Either String J.StepInRequest of+      Left  err -> errRes jsonStr $ "stepIn parse error. [" ++ err ++ "]" +      Right req -> stepInHandler cmdData mvarCtx req+++    handle jsonStr "stepOut" = case J.eitherDecode jsonStr :: Either String J.StepOutRequest of+      Left  err -> errRes jsonStr $ "stepOut parse error. [" ++ err ++ "]" +      Right req -> do+        resSeq <- incResSeq mvarCtx+        let res    = J.defaultStepOutResponse resSeq req+            resStr = J.encode $ res{J.successStepOutResponse = False, J.messageStepOutResponse = "unsupported command."}+        sendResponse resStr+ +        putStrLnStderr mvarCtx "stepout command is not supported."+++    handle jsonStr "pause" = case J.eitherDecode jsonStr :: Either String J.PauseRequest of+      Left  err -> errRes jsonStr $ "pause parse error. [" ++ err ++ "]" +      Right req -> do+        resSeq <- incResSeq mvarCtx+        let res    = J.defaultPauseResponse resSeq req+            resStr = J.encode $ res{J.successPauseResponse = False, J.messagePauseResponse = "unsupported command."}+        sendResponse resStr+ +        putStrLnStderr mvarCtx "pause command is not supported."+++    handle jsonStr "stackTrace" = case J.eitherDecode jsonStr :: Either String J.StackTraceRequest of+      Left  err -> errRes jsonStr $ "stackTrace parse error. [" ++ err ++ "]" +      Right req -> stackTraceHandler cmdData mvarCtx req+++    handle jsonStr "scopes" = case J.eitherDecode jsonStr :: Either String J.ScopesRequest of+      Left  err -> errRes jsonStr $ "scopes parse error. [" ++ err ++ "]" +      Right req -> scopesHandler cmdData mvarCtx req++++    handle jsonStr "variables" = case J.eitherDecode jsonStr :: Either String J.VariablesRequest of+      Left  err -> errRes jsonStr $ "variables parse error. [" ++ err ++ "]" +      Right req -> variablesHandler cmdData mvarCtx req+++    handle jsonStr "source" = case J.eitherDecode jsonStr :: Either String J.SourceRequest of+      Left  err -> errRes jsonStr $ "source parse error. [" ++ err ++ "]" +      Right req -> do+        resSeq <- incResSeq mvarCtx+        let res    = J.defaultSourceResponse resSeq req+            resStr = J.encode $ res{J.successSourceResponse = False, J.messageSourceResponse = "unsupported command."}+        sendResponse resStr+ +        putStrLnStderr mvarCtx "source command is not supported."+++    handle jsonStr "threads" = case J.eitherDecode jsonStr :: Either String J.ThreadsRequest of+      Left  err -> errRes jsonStr $ "threads parse error. [" ++ err ++ "]" +      Right req -> threadsHandler cmdData mvarCtx req+++    handle jsonStr "evaluate" = case J.eitherDecode jsonStr :: Either String J.EvaluateRequest of+      Left  err -> errRes jsonStr $ "evaluate parse error. [" ++ err ++ "]" +      Right req -> evaluateHandler cmdData mvarCtx req+++    handle jsonStr cmd = do+      putStrLnStderr mvarCtx $ cmd ++ " command is not supported."+      putStrLnStderr mvarCtx $ lbs2str jsonStr ++ " is requested."+++-- |+--+sendEvent :: BSL.ByteString -> IO ()+sendEvent str = do+  infoM _LOG_NAME $ "[EVENT] Content-Length: " ++ show (BSL.length str)+  infoM _LOG_NAME $ "[EVENT] " ++ lbs2str str++  sendResponseInternal str++-- |+--+sendResponse :: BSL.ByteString -> IO ()+sendResponse str = do+  infoM _LOG_NAME $ "[RESPONSE] Content-Length: " ++ show (BSL.length str)+  infoM _LOG_NAME $ "[RESPONSE] " ++ lbs2str str++  sendResponseInternal str++-- |+--+sendResponseInternal :: BSL.ByteString -> IO ()+sendResponseInternal str = do+  BSL.hPut stdout $ BSL.append "Content-Length: " $ str2lbs $ show (BSL.length str)+  BSL.hPut stdout $ str2lbs _TWO_CRLF+  BSL.hPut stdout str+  hFlush stdout+++-- |=====================================================================+--+-- Handlers++-- |+--+initializeHandler :: MVar DebugContext -> J.InitializeRequest -> IO ()+initializeHandler mvarCtx (J.InitializeRequest seq _ _ _) = flip E.catches handlers $ do+  resSeq <- incResSeq mvarCtx+  let capa = J.InitializeResponseCapabilites False False True False []+      res  = J.InitializeResponse resSeq "response" seq True "initialize" "" capa++  sendResponse $ J.encode res++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = "initializeHandler:" ++ show e+      errorM _LOG_NAME msg++-- |+--+launchHandler :: DebugCommandData -> MVar DebugContext -> J.LaunchRequest -> IO ()+launchHandler cmdData mvarCtx req@(J.LaunchRequest _ _ _ args) = flip E.catches handlers $ do+  let ws = J.workspaceLaunchRequestArguments args+      su = J.startupLaunchRequestArguments args++  ctx <- takeMVar mvarCtx+  putMVar mvarCtx ctx {+      workspaceDebugContext = ws+    , startupDebugContext   = su+    }++  runGHCi cmdData mvarCtx ws++  loadHsFile cmdData mvarCtx su++  resSeq <- incResSeq mvarCtx+  sendResponse $ J.encode $ J.defaultLaunchResponse resSeq req++  resSeq <- incResSeq mvarCtx+  sendEvent $ J.encode $ J.defaultInitializedEvent resSeq++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = "launchHandler:" ++ show e+      errorM _LOG_NAME msg+++-- |+--+disconnectHandler :: DebugCommandData -> MVar DebugContext -> J.DisconnectRequest -> IO ()+disconnectHandler cmdData mvarCtx req = flip E.catches handlers $ do++  let exitCmd     = stopDebugCommandData cmdData+      quitCmd     = quitDebugCommandData cmdData+      readWhile   = readWhileDebugCommandData cmdData++  cmdStr <- quitCmd+  infoM _LOG_NAME cmdStr+  putStrLnStdout mvarCtx cmdStr++  str <- readWhile $ const True +  infoM _LOG_NAME str+  putStrLnStdout mvarCtx str++  code <- exitCmd++  infoM _LOG_NAME $ show code+  putStrLnStdout mvarCtx $ show code++  resSeq <- incResSeq mvarCtx+  sendResponse $ J.encode $ J.defaultDisconnectResponse resSeq req++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = "disconnectHandler:" ++ show e+      errorM _LOG_NAME msg+      putStrLnStderr mvarCtx msg++-- |+--+setBreakpointsHandler :: DebugCommandData -> MVar DebugContext -> J.SetBreakpointsRequest -> IO ()+setBreakpointsHandler cmdData mvarCtx req = flip E.catches handlers $ do++  ctx <- readMVar mvarCtx+  let cwd     = workspaceDebugContext ctx+      args    = J.argumentsSetBreakpointsRequest req+      source  = J.sourceSetBreakpointsRequestArguments args+      path    = J.pathSource source+      reqBps  = J.breakpointsSetBreakpointsRequestArguments args+      bps     = map (convBp cwd path) reqBps++  delete path+  resBody <- insert bps++  resSeq <- incResSeq mvarCtx+  let res = J.defaultSetBreakpointsResponse resSeq req+      resStr = J.encode res{J.bodySetBreakpointsResponse = J.SetBreakpointsResponseBody resBody}+  sendResponse resStr++  resSeq <- incResSeq mvarCtx+  let stopEvt    = J.defaultStoppedEvent resSeq+      stopEvtStr = J.encode stopEvt+  sendEvent stopEvtStr+++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = "setBreakpointsHandler:" ++ show e+      errorM _LOG_NAME msg++    convBp cwd path (J.SourceBreakpoint lineNo _ cond) =+      BreakPointData {+        moduleNameBreakPointData = src2mod cwd path+      , filePathBreakPointData   = path+      , lineNoBreakPointData     = lineNo+      , breakNoBreakPointData    = Nothing+      , conditionBreakPointData  = cond+      }++    delete path = do+      ctx <- takeMVar mvarCtx+      let bps = breakPointDatasDebugContext ctx+          newBps = MAP.filterWithKey (\(p,_) _-> path /= p) bps+          delBps = MAP.elems $ MAP.filterWithKey (\(p,_) _-> path == p) bps++      putMVar mvarCtx ctx{breakPointDatasDebugContext = newBps}++      debugM _LOG_NAME $ "del bps:" ++ show delBps++      mapM_ (deleteBreakPointOnCUI cmdData mvarCtx) delBps+++    insert reqBps = do++      results <- mapM insertInternal reqBps+      let addBps  = filter (\(_, (J.Breakpoint _ verified _ _ _ _)) -> verified) results+          resData = map snd results++      debugM _LOG_NAME $ "add bps:" ++ show addBps+      debugM _LOG_NAME $ "response bps:" ++ show resData++      ctx <- takeMVar mvarCtx+      let bps    = breakPointDatasDebugContext ctx+          newBps = foldr (\v@(BreakPointData _ p l _ _)->MAP.insert (p,l) v) bps $ map fst results+      putMVar mvarCtx ctx{breakPointDatasDebugContext = newBps}++      return resData++    insertInternal reqBp@(BreakPointData modName filePath lineNo _ _) = do++      let src = J.Source (Just modName) filePath Nothing Nothing ++      addBreakPointOnCUI cmdData mvarCtx reqBp >>= \case+        Right no -> return (reqBp{breakNoBreakPointData = Just no}, J.Breakpoint (Just no) True "" src lineNo 1)+        Left err -> return (reqBp, J.Breakpoint Nothing False err src lineNo 1)++-- |+--+--+threadsHandler :: DebugCommandData -> MVar DebugContext -> J.ThreadsRequest -> IO ()+threadsHandler _ mvarCtx req = flip E.catches handlers $ do+  resSeq <- incResSeq mvarCtx+  let resStr = J.encode $ J.defaultThreadsResponse resSeq req+  sendResponse resStr++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = "threadsHandler:" ++ show e+      errorM _LOG_NAME msg++-- |+--+--+scopesHandler :: DebugCommandData -> MVar DebugContext -> J.ScopesRequest -> IO ()+scopesHandler cmdData mvarCtx req = flip E.catches handlers $ do++  let args    = J.argumentsScopesRequest req+      traceId = J.frameIdScopesArguments args++  moveFrame cmdData mvarCtx traceId++  resSeq <- incResSeq mvarCtx+  let resStr = J.encode $ J.defaultScopesResponse resSeq req+  sendResponse resStr++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = "scopesHandler:" ++ show e+      errorM _LOG_NAME msg+++-- |+--+--+moveFrame :: DebugCommandData -> MVar DebugContext -> Int -> IO ()+moveFrame cmdData mvarCtx traceId = do+  ctx <- readMVar mvarCtx+  let curTraceId = currentFrameIdDebugContext ctx+      moveCount  = curTraceId - traceId+      traceCmd   = if 0 > moveCount then traceForwardDebugCommandData cmdData+                     else traceBackDebugCommandData cmdData+      getResult  = readDebugCommandData cmdData++  _ <- foldM (go traceCmd getResult) (""::String) [1..(abs moveCount)]++  ctx <- takeMVar mvarCtx+  putMVar mvarCtx ctx{currentFrameIdDebugContext = traceId}++  where+    go traceCmd getResult _ _ = do++      cmdStr <- traceCmd+      infoM _LOG_NAME cmdStr+      putStrLnStdout mvarCtx cmdStr++      cmdStr <- getResult+      infoM _LOG_NAME cmdStr+      putStrStdout mvarCtx cmdStr++      return cmdStr++-- |+--+--+variablesHandler :: DebugCommandData -> MVar DebugContext -> J.VariablesRequest -> IO ()+variablesHandler cmdData mvarCtx req = flip E.catches handlers $ do++  vals <- currentBindings++  resSeq <- incResSeq mvarCtx+  let res = J.defaultVariablesResponse resSeq req+      resStr = J.encode $ res{J.bodyVariablesResponse = J.VariablesBody vals}+  sendResponse resStr++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = "scopesHandler:" ++ show e+      errorM _LOG_NAME msg++    currentBindings = do+      let bindings = bindingsDebugCommandData cmdData+          getResult = readDebugCommandData cmdData++      cmdStr <- bindings+      infoM _LOG_NAME cmdStr+      -- putStrLnStdout mvarCtx cmdStr++      bindStr <- getResult+      infoM _LOG_NAME bindStr+      -- putStrStdout mvarCtx bindStr++      case getBindingDataList bindStr of+        Left err   -> do +          errorM _LOG_NAME $ show err+          putStrLnStderr mvarCtx $ show err+          return []++        Right dats -> return $ map convBind2Vals dats+    +    convBind2Vals (BindingData varName _ val) = J.Variable varName val 0+++-- |+--+--+stackTraceHandler :: DebugCommandData -> MVar DebugContext -> J.StackTraceRequest -> IO ()+stackTraceHandler cmdData mvarCtx req = flip E.catches handlers $ do+  ctx <- readMVar mvarCtx+  case debugStoppedPosDebugContext ctx of+    Nothing -> do+      resSeq <- incResSeq mvarCtx+      let body = J.StackTraceBody [] 0+          res  = J.defaultStackTraceResponse resSeq req+          resStr = J.encode $ res{J.bodyStackTraceResponse = body}+      sendResponse resStr+    +    Just rangeData -> do+      resSeq <- incResSeq mvarCtx++      frames <- createStackFrames rangeData+      debugM _LOG_NAME $ show frames++      let body   = J.StackTraceBody (reverse frames) (length frames)+          res    = J.defaultStackTraceResponse resSeq req+          resStr = J.encode $ res{J.bodyStackTraceResponse = body}+      sendResponse resStr++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = "stackTraceHandler:" ++ show e+      errorM _LOG_NAME msg+++    createStackFrames (HighlightTextRangeData file sl sc _ _) = do+      ctx <- readMVar mvarCtx+      let cwd = workspaceDebugContext ctx+          csf = J.StackFrame 0 "0" (J.Source (Just (src2mod cwd file)) file Nothing Nothing) sl sc++      let getResult = readDebugCommandData cmdData+          history   = traceHistDebugCommandData cmdData+    +      cmdStr <- history+      infoM _LOG_NAME cmdStr+      -- putStrLnStdout mvarCtx cmdStr++      traceStr <- getResult+      infoM _LOG_NAME traceStr+      -- putStrStdout mvarCtx traceStr+ +      case getTraceDataList traceStr of+        Left err   -> do+          errorM _LOG_NAME $ show err+          -- putStrLnStderr mvarCtx $ show err+          return [csf]++        Right dats -> foldM (convTrace2Frame cwd) [csf] dats++    convTrace2Frame cwd xs (TraceData traceId _ filePath) = case parse parseHighlightTextRange "getActivatePosFromLine" filePath of+      Left err -> do+        infoM _LOG_NAME $ show err+        return xs+      Right (HighlightTextRangeData file sl sc _ _) -> return $ +        J.StackFrame (read traceId) traceId (J.Source (Just (src2mod cwd file)) file Nothing Nothing) sl sc : xs++-- |+--+--+evaluateHandler :: DebugCommandData -> MVar DebugContext -> J.EvaluateRequest -> IO ()+evaluateHandler cmdData mvarCtx req = flip E.catches handlers $ do++  let (J.EvaluateArguments exp frameId ctx) = J.argumentsEvaluateRequest req+      +  moveFrame cmdData mvarCtx $ if isJust frameId then fromJust frameId else 0+  eval ctx exp+++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = "continueHandler:" ++ show e+      errorM _LOG_NAME msg++    eval "watch" exp = do+      let forceVar = forceDebugCommandData cmdData+          getResult = readDebugCommandData cmdData++      cmdStr <- forceVar exp+      infoM _LOG_NAME cmdStr+      putStrLnStdout mvarCtx cmdStr+    +      cmdStr <- getResult+      infoM _LOG_NAME cmdStr+      putStrStdout mvarCtx cmdStr++      let result = L.intercalate " " . filter (not . null) . map strip . init . lines $ cmdStr++      resSeq <- incResSeq mvarCtx+      let body   = J.EvaluateBody result 0+          res    = J.defaultEvaluateResponse resSeq req+          resStr = J.encode res{J.bodyEvaluateResponse = body}+      sendResponse resStr+++    eval "repl" exp = do+      let exec = execCommandData cmdData+          getResult = readDebugCommandData cmdData++      cmdStr <- exec exp+      infoM _LOG_NAME cmdStr+    +      cmdStr <- getResult+      infoM _LOG_NAME cmdStr++      let result = L.intercalate " " . filter (not . null) . map strip . init . lines $ cmdStr++      resSeq <- incResSeq mvarCtx+      let body   = J.EvaluateBody result 0+          res    = J.defaultEvaluateResponse resSeq req+          resStr = J.encode res{J.bodyEvaluateResponse = body}+      sendResponse resStr+    +      putStrStdout mvarCtx $ "\n" ++ _PHOITYNE_GHCI_PROMPT++    eval _ exp = do+      let exec = execCommandData cmdData+          getResult = readDebugCommandData cmdData++      cmdStr <- exec exp+      infoM _LOG_NAME cmdStr+      putStrLnStdout mvarCtx cmdStr++      cmdStr <- getResult+      infoM _LOG_NAME cmdStr+      putStrLnStdout mvarCtx cmdStr++      let result = L.intercalate " " . filter (not . null) . map strip . init . lines $ cmdStr++      resSeq <- incResSeq mvarCtx+      let body   = J.EvaluateBody result 0+          res    = J.defaultEvaluateResponse resSeq req+          resStr = J.encode res{J.bodyEvaluateResponse = body}+      sendResponse resStr+    ++-- |+--+--+continueHandler :: DebugCommandData -> MVar DebugContext -> J.ContinueRequest -> IO ()+continueHandler cmdData mvarCtx req = flip E.catches handlers $ do+  resSeq <- incResSeq mvarCtx+  let resStr = J.encode $ J.defaultContinueResponse resSeq req+  sendResponse resStr++  startDebug cmdData mvarCtx++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = "continueHandler:" ++ show e+      errorM _LOG_NAME msg+++-- |+--+--+startDebug :: DebugCommandData -> MVar DebugContext -> IO ()+startDebug cmdData mvarCtx = do+  ctx <- readMVar mvarCtx+  let started = debugStartedDebugContext ctx+  +  startDebugInternal started++  ctx <- takeMVar mvarCtx+  putMVar mvarCtx ctx{currentFrameIdDebugContext = 0}++  where+    startDebugInternal True = do+      let continue  = continueDebugCommandData cmdData+          getResult = readDebugCommandData cmdData+    +      cmdStr <- continue True+      infoM _LOG_NAME cmdStr+      putStrLnStdout mvarCtx cmdStr++      cmdStr <- getResult+      infoM _LOG_NAME cmdStr+      putStrStdout mvarCtx cmdStr++      sendEventByDebugStopStatus cmdData mvarCtx cmdStr   ++    startDebugInternal False = do+      let getResult  = readDebugCommandData cmdData+          runDebug   = runDebugCommandData cmdData+    +      cmdStr <- runDebug True+      infoM _LOG_NAME cmdStr+      putStrLnStdout mvarCtx cmdStr+    +      cmdStr <- getResult+      infoM _LOG_NAME cmdStr+      putStrStdout mvarCtx cmdStr+    +      sendEventByDebugStopStatus cmdData mvarCtx cmdStr+++-- |+--+--+sendEventByDebugStopStatus :: DebugCommandData -> MVar DebugContext -> String -> IO ()+sendEventByDebugStopStatus _ mvarCtx cmdStr = case getStoppedTextRangeData cmdStr of+  Left err  -> do+    infoM _LOG_NAME $ show err+    --putStrLnStdout mvarCtx $ show err++    resSeq <- incResSeq mvarCtx+    let terminatedEvt    = J.defaultTerminatedEvent resSeq+        terminatedEvtStr = J.encode terminatedEvt+    sendEvent terminatedEvtStr++  Right pos -> do+    infoM _LOG_NAME $ show pos++    ctx <- takeMVar mvarCtx+    putMVar mvarCtx ctx{debugStartedDebugContext = True, debugStoppedPosDebugContext = Just pos}++    resSeq <- incResSeq mvarCtx+    let stopEvt    = J.defaultStoppedEvent resSeq+        stopEvtStr = J.encode stopEvt+    sendEvent stopEvtStr+++-- |+--+--+stepOverHandler :: DebugCommandData -> MVar DebugContext -> J.NextRequest -> IO ()+stepOverHandler cmdData mvarCtx req = flip E.catches handlers $ do+  ctx <- readMVar mvarCtx+  case debugStoppedPosDebugContext ctx of+    Nothing -> do+      resSeq <- incResSeq mvarCtx+      let res    = J.defaultNextResponse resSeq req+          resStr = J.encode res{J.successNextResponse = False, J.messageNextResponse = "debug is initialized but not started yet. press F5(continue)."}+      sendResponse resStr+    Just _ -> stepOver++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = "continueHandler:" ++ show e+      errorM _LOG_NAME msg++    stepOver = do+      let step = stepOverDebugCommandData cmdData+          getResult = readDebugCommandData cmdData+       +      cmdStr <- step+      infoM _LOG_NAME cmdStr+      putStrLnStdout mvarCtx cmdStr+    +      cmdStr <- getResult+      infoM _LOG_NAME cmdStr+      putStrStdout mvarCtx cmdStr++      case getStoppedTextRangeData cmdStr of+        Left err  -> do+          infoM _LOG_NAME $ show err+          --putStrLnStdout mvarCtx $ show err+      +          resSeq <- incResSeq mvarCtx+          let terminatedEvt    = J.defaultTerminatedEvent resSeq+              terminatedEvtStr = J.encode terminatedEvt+          sendEvent terminatedEvtStr++        Right pos -> do+          ctx <- takeMVar mvarCtx+          putMVar mvarCtx ctx{debugStoppedPosDebugContext = Just pos}+    +          resSeq <- incResSeq mvarCtx+          let res    = J.defaultNextResponse resSeq req+              resStr = J.encode res+          sendResponse resStr+    +          resSeq <- incResSeq mvarCtx+          let stopEvt    = J.defaultStoppedEvent resSeq+              stopEvtStr = J.encode stopEvt+          sendEvent stopEvtStr+++-- |+--+--+stepInHandler :: DebugCommandData -> MVar DebugContext -> J.StepInRequest -> IO ()+stepInHandler cmdData mvarCtx req = flip E.catches handlers $ do+  ctx <- readMVar mvarCtx+  case debugStoppedPosDebugContext ctx of+    Nothing -> do+      resSeq <- incResSeq mvarCtx+      let res    = J.defaultStepInResponse resSeq req+          resStr = J.encode res{J.successStepInResponse = False, J.messageStepInResponse = "debug is initialized but not started yet. press F5(continue)."}+      sendResponse resStr+    Just _ -> stepIn++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = "continueHandler:" ++ show e+      errorM _LOG_NAME msg++    stepIn = do+      let step = stepDebugCommandData cmdData+          getResult = readDebugCommandData cmdData+       +      cmdStr <- step+      infoM _LOG_NAME cmdStr+      putStrLnStdout mvarCtx cmdStr+    +      cmdStr <- getResult+      infoM _LOG_NAME cmdStr+      putStrStdout mvarCtx cmdStr++      case getStoppedTextRangeData cmdStr of+        Left err  -> do+          infoM _LOG_NAME $ show err+          --putStrLnStdout mvarCtx $ show err+      +          resSeq <- incResSeq mvarCtx+          let terminatedEvt    = J.defaultTerminatedEvent resSeq+              terminatedEvtStr = J.encode terminatedEvt+          sendEvent terminatedEvtStr++        Right pos -> do+          ctx <- takeMVar mvarCtx+          putMVar mvarCtx ctx{debugStoppedPosDebugContext = Just pos}+    +          resSeq <- incResSeq mvarCtx+          let res    = J.defaultStepInResponse resSeq req+              resStr = J.encode res+          sendResponse resStr+    +          resSeq <- incResSeq mvarCtx+          let stopEvt    = J.defaultStoppedEvent resSeq+              stopEvtStr = J.encode stopEvt+          sendEvent stopEvtStr+++++-- |=====================================================================+--+--  utility+++-- |+--+--+putStrConsole :: MVar DebugContext -> String -> IO ()+putStrConsole mvarCtx msg = do+  resSeq <- incResSeq mvarCtx+  let outEvt  = J.defaultOutputEvent resSeq+      outEvtStr = J.encode outEvt{J.bodyOutputEvent = J.OutputEventBody "console" msg Nothing }+  sendEvent outEvtStr++-- |+--+--+putStrLnStdout :: MVar DebugContext -> String -> IO ()+putStrLnStdout mvarCtx msg = putStrStdout mvarCtx (msg ++ "\n")++-- |+--+--+putStrStdout :: MVar DebugContext -> String -> IO ()+putStrStdout mvarCtx msg = do+  resSeq <- incResSeq mvarCtx+  let outEvt    = J.defaultOutputEvent resSeq+      outEvtStr = J.encode outEvt{J.bodyOutputEvent = J.OutputEventBody "stdout" msg Nothing }+  sendEvent outEvtStr++-- |+--+--+putStrLnStderr :: MVar DebugContext -> String -> IO ()+putStrLnStderr mvarCtx msg = putStrStderr mvarCtx (msg ++ "\n")++-- |+--+--+putStrStderr :: MVar DebugContext -> String -> IO ()+putStrStderr mvarCtx msg = do+  resSeq <- incResSeq mvarCtx+  let outEvt    = J.defaultOutputEvent resSeq+      outEvtStr = J.encode outEvt{J.bodyOutputEvent = J.OutputEventBody "stderr" msg Nothing }+  sendEvent outEvtStr++++-- |+--+--+src2mod :: FilePath -> FilePath -> String+src2mod cwd src +  | length cwd >= length src = ""+  | otherwise = L.intercalate "."+      $ map takeBaseName+      $ reverse+      $ takeWhile startUpperCase+      $ reverse+      $ splitOneOf [_SEP_WIN, _SEP_UNIX]+      $ drop (length cwd) src++  where+    startUpperCase modName +      | null modName = True+      | otherwise = isUpper $ head modName+++-- |+--+--+incResSeq :: MVar DebugContext -> IO Int+incResSeq mvarCtx = do+  ctx <- takeMVar mvarCtx+  let resSec = 1 + resSeqDebugContext ctx+  putMVar mvarCtx ctx{resSeqDebugContext = resSec}+  return resSec++-- |+--+--+runGHCi :: DebugCommandData -> MVar DebugContext -> FilePath -> IO Bool+runGHCi cmdData mvarCtx cwd = do+  let startCmd  = startDebugCommandData cmdData+      readWhile = readWhileDebugCommandData cmdData++  infoM _LOG_NAME "% stack ghci --test --no-load --no-build \n"+  putStrLnStdout mvarCtx "% stack ghci --test --no-load --no-build \n"++  startCmd cwd++  str <- readWhile $ not . endswith _GHCI_PROMPT++  infoM _LOG_NAME str+  putStrStdout mvarCtx str++  withStarted $ endswith _GHCI_PROMPT str++  where+    withStarted False = return False+    withStarted True = do+      readAndSetPrompt+      return True++    readAndSetPrompt = do+      let setPrompt = promptDebugCommandData cmdData+          getResult = readDebugCommandData cmdData+          printEvld = printEvldDebugCommandData cmdData++      promptStr <- setPrompt+      putStrLnStdout mvarCtx promptStr+      infoM _LOG_NAME promptStr++      cmdStr <- getResult+      putStrStdout mvarCtx cmdStr+      infoM _LOG_NAME cmdStr++      cmdStr <- printEvld+      putStrLnStdout mvarCtx cmdStr+      infoM _LOG_NAME cmdStr++      cmdStr <- getResult+      putStrStdout mvarCtx cmdStr+      infoM _LOG_NAME cmdStr+++-- |+--+--+loadHsFile :: DebugCommandData -> MVar DebugContext -> FilePath -> IO Bool+loadHsFile cmdData mvarCtx path+  | (False == endswith _HS_FILE_EXT path) = return False+  | otherwise = do+    let loadFile  = loadFileDebugCommandData cmdData+        readLines = readLinesDebugCommandData cmdData+        getResult = readDebugCommandData cmdData+  +    cmdStr <- loadFile path+    putStrLnStdout mvarCtx cmdStr+    infoM _LOG_NAME cmdStr+  +    cont <- readLines debugStartResultHandler+  +    if | null cont -> return False+       | startswith "Ok," (last cont) -> do+         cmdStr <- getResult+         putStrStdout mvarCtx cmdStr+         infoM _LOG_NAME cmdStr+         return True+       | startswith "Failed," (last cont) -> do+         cmdStr <- getResult+         putStrStdout mvarCtx cmdStr+         infoM _LOG_NAME cmdStr+         return False+       | otherwise -> do+         errorM _LOG_NAME $ "load file fail.["++ path ++"]"+         putStrLnStderr mvarCtx $ "load file fail.["++ path ++"]"+         return False++  where+    debugStartResultHandler :: [String] -> IO Bool+    debugStartResultHandler acc = putStrLnStdout mvarCtx curStr >> infoM _LOG_NAME curStr >> if+      | L.isPrefixOf "Ok," curStr -> return False+      | L.isPrefixOf "Failed," curStr -> return False+      | otherwise -> return True+      where+        curStr | null acc = ""+               | otherwise = last acc+++-- |+--  ブレークポイントをGHCi上でdeleteする+--+deleteBreakPointOnCUI :: DebugCommandData -> MVar DebugContext -> BreakPointData -> IO ()+deleteBreakPointOnCUI cmdData mvarCtx (BreakPointData _ _ _ (Just breakNo) _) = do+  let deleteBreak = deleteBreakDebugCommandData cmdData+      getResult   = readDebugCommandData cmdData++  cmdStr <- deleteBreak breakNo+  -- putStrLnStdout mvarCtx cmdStr+  infoM _LOG_NAME cmdStr++  cmdStr <- getResult+  -- putStrStdout mvarCtx cmdStr+  infoM _LOG_NAME cmdStr++deleteBreakPointOnCUI _ mvarCtx bp = do+  let err = "invalid delete break point."  ++ show bp+  putStrLnStderr mvarCtx err+  errorM _LOG_NAME err+++-- |+--  GHCi上でブレークポイントを追加する+--+addBreakPointOnCUI :: DebugCommandData -> MVar DebugContext -> BreakPointData -> IO (Either String Int)+addBreakPointOnCUI cmdData mvarCtx (BreakPointData modName _ lineNo _ _) = do++  let setBreak    = breakDebugCommandData cmdData+      getResult   = readDebugCommandData cmdData++  cmdStr <- setBreak modName lineNo+  -- putStrLnStdout mvarCtx cmdStr+  infoM _LOG_NAME cmdStr++  cmdStr <- getResult+  -- putStrStdout mvarCtx cmdStr+  infoM _LOG_NAME cmdStr++  case getBreakPointNo cmdStr of+    Right no  -> return $ Right no +    Left  err -> if L.isPrefixOf _NO_BREAK_POINT_LOCATION cmdStr+                   then return $ Left _NO_BREAK_POINT_LOCATION+                   else do+                     let msg = "unexpected break set result. " ++ show err ++ cmdStr+                     errorM _LOG_NAME msg+                     return $ Left msg+  +  where+  +    -- |+    --  parser of+    --   Breakpoint 0 activated at src\Main.hs:(21,3)-(23,35)+    --+    getBreakPointNo :: String -> Either ParseError Int+    getBreakPointNo res = parse parser "getBreakPointNo" res+      where+        parser = do+          _ <- manyTill anyChar (string "Breakpoint ")+          no <- manyTill digit (string " activated at")+          return $ read no+++-- |=====================================================================+--+--  パーサ+--++-- |+--+--+getStoppedTextRangeData :: String -> Either ParseError HighlightTextRangeData+getStoppedTextRangeData = parse parser "getStoppedTextRangeData"+  where+    parser = do+      _ <- manyTill anyChar (try (string "Stopped at "))+      parseHighlightTextRange+++-- |+--  parser of+--   A) src\Phoityne\IO\Main.hs:31:11-14+--   B) src\Main.hs:(17,3)-(19,35)+--   C) src\Phoityne\IO\Main.hs:31:11+--      src\Phoityne\IO\Main.hs:31:11:+--+parseHighlightTextRange :: forall u. ParsecT String u Identity HighlightTextRangeData+parseHighlightTextRange = do+  path <- manyTill anyChar (string (_HS_FILE_EXT ++ ":"))+  (sl, sn, el, en) <- try parseA <|> try parseB <|> try parseC+  return $ HighlightTextRangeData (path ++ _HS_FILE_EXT) sl sn el en+  where+    parseA = do+      ln <- manyTill digit (char ':')+      sn <- manyTill digit (char '-')+      en <- try (manyTill digit endOfLine) <|> try (manyTill digit eof)+      return ((read ln), (read sn), (read ln), (read en))++    parseB = do+      _ <- char '('+      sl <- manyTill digit (char ',')+      sn <- manyTill digit (char ')')+      _ <- string "-("+      el <- manyTill digit (char ',')+      en <- manyTill digit (char ')')+      return ((read sl), (read sn), (read el), (read en))++    parseC = do+      ln <- manyTill digit (char ':')+      sn <- try (manyTill digit (char ':')) <|> try (manyTill digit endOfLine) <|> try (manyTill digit eof)+      return ((read ln), (read sn), (read ln), (read sn))++-- |+--  トレース情報のパーサ+--+--  parser of+--    Phoityne>>= :history+--    -1  : config:confB (src\Project\Argument.hs:85:17-28)+--    -2  : config:confB (src\Project\Argument.hs:87:17-36)+--                        src\Project\IO\Main.hs:(70,9)-(71,65)+--+--    -1  : main (D:\haskell\vsc-sample\app\Main.hs:6:8-15)+--+getTraceDataList :: String -> Either ParseError [TraceData]+getTraceDataList res = go [] $ reverse $ filter (L.isPrefixOf "-") $ lines res+  where+    go acc [] = Right acc+    go acc (x:xs) = case parse parser "getTraceDataList" x of+      Left err -> Left err+      Right dat -> go (dat:acc) xs++    parser = do+      traceId  <- manyTill anyChar (many1 space >> char ':' >> space)+      funcName <- manyTill anyChar (space >> char '(')+      filePath <- manyTill anyChar eof++      return $ TraceData (strip traceId) funcName (init (strip filePath))++-- |+--  バインディング値のパーサ+--+--  parser of+--   args :: Project.Argument.ArgData = _+--   _result :: IO Data.ConfigFile.Types.ConfigParser = _+--+getBindingDataList :: String -> Either ParseError [BindingData]+getBindingDataList res = parse parser "getBindingDataList" res+  where+    parser = manyTill parser1 (string _PHOITYNE_GHCI_PROMPT)++    parser1 = do+      varName <- manyTill anyChar (string "::")+      modName <- manyTill anyChar (try (string "="))+      valStr  <- manyTill anyChar lineSep <|> manyTill anyChar eof++      return $ BindingData (strip varName) (strip modName) valStr++    lineSep = try $ endOfLine >> notFollowedBy space+++
+ app/Phoityne/IO/GUI/VSCode/TH/BreakpointJSON.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE TemplateHaskell     #-}++module Phoityne.IO.GUI.VSCode.TH.BreakpointJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.SourceJSON++-- |+--   Information about a Breakpoint created in setBreakpoints or setFunctionBreakpoints.+--+data Breakpoint =+  Breakpoint {+    idBreakpoint       :: Maybe Int -- An optional unique identifier for the breakpoint.+  , verifiedBreakpoint :: Bool      -- If true breakpoint could be set (but not necessarily at the desired location).+  , messageBreakpoint  :: String    -- An optional message about the state of the breakpoint. This is shown to the user and can be used to explain why a breakpoint could not be verified.+  , sourceBreakpoint   :: Source    -- The source where the breakpoint is located.+  , lineBreakpoint     :: Int       -- The actual line of the breakpoint.+  , columnBreakpoint   :: Int       -- The actual column of the breakpoint.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "Breakpoint") } ''Breakpoint)++
+ app/Phoityne/IO/GUI/VSCode/TH/ContinueArgumentsJSON.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.ContinueArgumentsJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Arguments for "disconnect" request.+--+data ContinueArguments =+  ContinueArguments {+    threadIdContinueArguments :: Int --  continue execution for this thread.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "ContinueArguments") } ''ContinueArguments)
+ app/Phoityne/IO/GUI/VSCode/TH/ContinueRequestJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.ContinueRequestJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.ContinueArgumentsJSON++-- |+--   Continue request; value of command field is "continue".+--   The request starts the debuggee to run again.+--+data ContinueRequest =+  ContinueRequest {+    seqContinueRequest       :: Int               -- Sequence number+  , typeContinueRequest      :: String            -- One of "request", "response", or "event"+  , commandContinueRequest   :: String            -- The command to execute+  , argumentsContinueRequest :: ContinueArguments -- Arguments for "continue" request.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "ContinueRequest") } ''ContinueRequest)
+ app/Phoityne/IO/GUI/VSCode/TH/ContinueResponseJSON.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.ContinueResponseJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.ContinueRequestJSON ++-- |+--   Response to "continue" request. This is just an acknowledgement, so no body field is required. +--+data ContinueResponse =+  ContinueResponse {+    seqContinueResponse         :: Int     -- Sequence number+  , typeContinueResponse        :: String  -- One of "request", "response", or "event"+  , request_seqContinueResponse :: Int     -- Sequence number of the corresponding request+  , successContinueResponse     :: Bool    -- Outcome of the request+  , commandContinueResponse     :: String  -- The command requested +  , messageContinueResponse     :: String  -- Contains error message if success == false.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "ContinueResponse") } ''ContinueResponse)++-- |+--+defaultContinueResponse :: Int -> ContinueRequest ->  ContinueResponse+defaultContinueResponse seq (ContinueRequest reqSeq _ _ _) =+  ContinueResponse seq "response" reqSeq True "continue" ""++
+ app/Phoityne/IO/GUI/VSCode/TH/DisconnectArgumentsJSON.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.DisconnectArgumentsJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Arguments for "disconnect" request.+--+data DisconnectArguments =+  DisconnectArguments {+    restartDisconnectArguments :: Maybe Bool+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "DisconnectArguments") } ''DisconnectArguments)
+ app/Phoityne/IO/GUI/VSCode/TH/DisconnectRequestJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.DisconnectRequestJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.DisconnectArgumentsJSON++-- |+--   Disconnect request; value of command field is "disconnect".+--+data DisconnectRequest =+  DisconnectRequest {+    seqDisconnectRequest       :: Int                        -- Sequence number+  , typeDisconnectRequest      :: String                     -- One of "request", "response", or "event"+  , commandDisconnectRequest   :: String                     -- The command to execute+  , argumentsDisconnectRequest :: Maybe DisconnectArguments  -- Arguments for "disconnect" request.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "DisconnectRequest") } ''DisconnectRequest)+
+ app/Phoityne/IO/GUI/VSCode/TH/DisconnectResponseJSON.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.DisconnectResponseJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.DisconnectRequestJSON++-- |+--   Response to "disconnect" request. This is just an acknowledgement, so no body field is required.+--+data DisconnectResponse =+  DisconnectResponse {+    seqDisconnectResponse         :: Int     -- Sequence number+  , typeDisconnectResponse        :: String  -- One of "request", "response", or "event"+  , request_seqDisconnectResponse :: Int     -- Sequence number of the corresponding request+  , successDisconnectResponse     :: Bool    -- Outcome of the request+  , commandDisconnectResponse     :: String  -- The command requested +  , messageDisconnectResponse     :: String  -- Contains error message if success == false.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "DisconnectResponse") } ''DisconnectResponse)++-- |+--+defaultDisconnectResponse :: Int -> DisconnectRequest ->  DisconnectResponse+defaultDisconnectResponse seq (DisconnectRequest reqSeq _ _ _) =+  DisconnectResponse seq "response" reqSeq True "disconnect" ""
+ app/Phoityne/IO/GUI/VSCode/TH/ErrorResponseBodyJSON.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.ErrorResponseBodyJSON where++import Data.Aeson+import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.MessageJSON++-- |+--    On error that is whenever 'success' is false, the body can provide more details. +--+data ErrorResponseBody =+  ErrorResponseBody {+    errorErrorResponseBody :: Message  -- An optional, structured error message.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "ErrorResponseBody") } ''ErrorResponseBody)++-- |+--+defaultErrorResponseBody :: ErrorResponseBody+defaultErrorResponseBody = ErrorResponseBody defaultMessage++
+ app/Phoityne/IO/GUI/VSCode/TH/ErrorResponseJSON.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE TemplateHaskell     #-}++module Phoityne.IO.GUI.VSCode.TH.ErrorResponseJSON where++import Data.Aeson+import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.ErrorResponseBodyJSON++-- |+--   On error that is whenever 'success' is false, the body can provide more details.+--+data ErrorResponse =+  ErrorResponse {+    seqErrorResponse         :: Int     -- Sequence number+  , typeErrorResponse        :: String  -- One of "request", "response", or "event"+  , request_seqErrorResponse :: Int     -- Sequence number of the corresponding request+  , successErrorResponse     :: Bool    -- Outcome of the request+  , commandErrorResponse     :: String  -- The command requested +  , messageErrorResponse     :: String  -- Contains error message if success == false.+  , bodyErrorResponse        :: ErrorResponseBody+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "ErrorResponse") } ''ErrorResponse)++-- |+--+defaultErrorResponse :: Int -> Int -> String -> ErrorResponse+defaultErrorResponse seq reqSeq cmd =+  ErrorResponse seq "response" reqSeq False cmd "" defaultErrorResponseBody
+ app/Phoityne/IO/GUI/VSCode/TH/EvaluateArgumentsJSON.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.EvaluateArgumentsJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Arguments for "evaluate" request.+--+data EvaluateArguments =+  EvaluateArguments {+    expressionEvaluateArguments :: String     -- The expression to evaluate. +  , frameIdEvaluateArguments    :: Maybe Int  -- Evaluate the expression in the scope of this stack frame. If not specified, the expression is evaluated in the global scope.  +  , contextEvaluateArguments    :: String     -- The context in which the evaluate request is run. Possible values are 'watch' if evaluate is run in a watch, 'repl' if run from the REPL console, or 'hover' if run from a data hover.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "EvaluateArguments") } ''EvaluateArguments)
+ app/Phoityne/IO/GUI/VSCode/TH/EvaluateBodyJSON.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.EvaluateBodyJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--    Response to "evaluate" request. +--+data EvaluateBody =+  EvaluateBody {+    resultEvaluateBody             :: String -- The result of the evaluate.+  , variablesReferenceEvaluateBody :: Int    -- If variablesReference is > 0, the evaluate result is structured and its children can be retrieved by passing variablesReference to the VariablesRequest+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "EvaluateBody") } ''EvaluateBody)++-- |+--+defaultEvaluateBody :: EvaluateBody+defaultEvaluateBody = EvaluateBody "" 0+++
+ app/Phoityne/IO/GUI/VSCode/TH/EvaluateRequestJSON.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.EvaluateRequestJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.EvaluateArgumentsJSON++-- |+--   Evaluate request; value of command field is "evaluate".+--   Evaluates the given expression in the context of the top most stack frame.+--   The expression has access to any variables and arguments that are in scope.+--+data EvaluateRequest =+  EvaluateRequest {+    seqEvaluateRequest       :: Int                -- Sequence number+  , typeEvaluateRequest      :: String             -- One of "request", "response", or "event"+  , commandEvaluateRequest   :: String             -- The command to execute+  , argumentsEvaluateRequest :: EvaluateArguments  -- Arguments for "evaluate" request.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "EvaluateRequest") } ''EvaluateRequest)
+ app/Phoityne/IO/GUI/VSCode/TH/EvaluateResponseJSON.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.EvaluateResponseJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.EvaluateBodyJSON+import Phoityne.IO.GUI.VSCode.TH.EvaluateRequestJSON++-- |+--  Response to "evaluate" request.+--+data EvaluateResponse =+  EvaluateResponse {+    seqEvaluateResponse         :: Int     -- Sequence number+  , typeEvaluateResponse        :: String  -- One of "request", "response", or "event"+  , request_seqEvaluateResponse :: Int     -- Sequence number of the corresponding request+  , successEvaluateResponse     :: Bool    -- Outcome of the request+  , commandEvaluateResponse     :: String  -- The command requested +  , messageEvaluateResponse     :: String  -- Contains error message if success == false.+  , bodyEvaluateResponse        :: EvaluateBody+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "EvaluateResponse") } ''EvaluateResponse)+++-- |+--+defaultEvaluateResponse :: Int -> EvaluateRequest -> EvaluateResponse+defaultEvaluateResponse seq (EvaluateRequest reqSeq _ _ _) =+  EvaluateResponse seq "response" reqSeq True "evaluate" "" defaultEvaluateBody+
+ app/Phoityne/IO/GUI/VSCode/TH/ExceptionBreakpointsFilterJSON.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE TemplateHaskell #-}+++module Phoityne.IO.GUI.VSCode.TH.ExceptionBreakpointsFilterJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   An ExceptionBreakpointsFilter is shown in the UI as an option for configuring how exceptions are dealt with.+--+data ExceptionBreakpointsFilter =+  ExceptionBreakpointsFilter {+    filterExceptionBreakpointsFilter  :: String  -- The internal ID of the filter. This value is passed to the setExceptionBreakpoints request.+  , labelExceptionBreakpointsFilter   :: String  -- The name of the filter. This will be shown in the UI.+  , defaultExceptionBreakpointsFilter :: Bool    -- Initial value of the filter. If not specified a value 'false' is assumed.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "ExceptionBreakpointsFilter") } ''ExceptionBreakpointsFilter)+
+ app/Phoityne/IO/GUI/VSCode/TH/ExitedEventBodyJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.ExitedEventBodyJSON where++import Data.Aeson+import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Event message for "exited" event type.+--   The event indicates that the debuggee has exited.+--+data ExitedEventBody =+  ExitedEventBody {+    exitCodeExitedEventBody :: Int -- The exit code returned from the debuggee.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "ExitedEventBody") } ''ExitedEventBody)++defaultExitedEventBody code = ExitedEventBody code+
+ app/Phoityne/IO/GUI/VSCode/TH/ExitedEventJSON.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.ExitedEventJSON where++import Data.Aeson+import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.ExitedEventBodyJSON++-- |+--   Event message for "exited" event type.+--   The event indicates that the debuggee has exited.+--+data ExitedEvent =+  ExitedEvent {+    seqExitedEvent   :: Int     -- Sequence number+  , typeExitedEvent  :: String  -- One of "request", "response", or "event"+  , eventExitedEvent :: String  -- Type of event+  , bodyExitedEvent  :: ExitedEventBody+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "ExitedEvent") } ''ExitedEvent)++defaultExitedEvent seq code = ExitedEvent seq "event" "exited" $ defaultExitedEventBody code+
+ app/Phoityne/IO/GUI/VSCode/TH/InitializeRequestArgumentsJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell #-}+++module Phoityne.IO.GUI.VSCode.TH.InitializeRequestArgumentsJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Initialize request; value of command field is "initialize".+--+data InitializeRequestArguments =+  InitializeRequestArguments {+    adapterIDInitializeRequestArguments       :: String  -- The ID of the debugger adapter. Used to select or verify debugger adapter.+  , linesStartAt1InitializeRequestArguments   :: Bool    -- If true all line numbers are 1-based (default).+  , columnsStartAt1InitializeRequestArguments :: Bool    -- If true all column numbers are 1-based (default).+  , pathFormatInitializeRequestArguments      :: String  -- Determines in what format paths are specified. Possible values are 'path' or 'uri'. The default is 'path', which is the native format.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "InitializeRequestArguments") } ''InitializeRequestArguments)+
+ app/Phoityne/IO/GUI/VSCode/TH/InitializeRequestJSON.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE TemplateHaskell #-}++module Phoityne.IO.GUI.VSCode.TH.InitializeRequestJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.InitializeRequestArgumentsJSON++-- |+--   Client-initiated request+--+data InitializeRequest =+  InitializeRequest {+    seqInitializeRequest       :: Int                         -- Sequence number+  , typeInitializeRequest      :: String                      -- One of "request", "response", or "event"+  , commandInitializeRequest   :: String                      -- The command to execute+  , argumentsInitializeRequest :: InitializeRequestArguments  -- Object containing arguments for the command+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "InitializeRequest") } ''InitializeRequest)+
+ app/Phoityne/IO/GUI/VSCode/TH/InitializeResponseCapabilitesJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell #-}+++module Phoityne.IO.GUI.VSCode.TH.InitializeResponseCapabilitesJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.ExceptionBreakpointsFilterJSON++-- |+--   Information about the capabilities of a debug adapter.+--+data InitializeResponseCapabilites =+  InitializeResponseCapabilites {+    supportsConfigurationDoneRequestInitializeResponseCapabilites :: Bool  -- The debug adapter supports the configurationDoneRequest.+  , supportsFunctionBreakpointsInitializeResponseCapabilites      :: Bool  -- The debug adapter supports functionBreakpoints.+  , supportsConditionalBreakpointsInitializeResponseCapabilites   :: Bool  -- The debug adapter supports conditionalBreakpoints.+  , supportsEvaluateForHoversInitializeResponseCapabilites        :: Bool  -- The debug adapter supports a (side effect free) evaluate request for data hovers.+  , exceptionBreakpointFiltersInitializeResponseCapabilites       :: [ExceptionBreakpointsFilter]  -- Available filters for the setExceptionBreakpoints request.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "InitializeResponseCapabilites") } ''InitializeResponseCapabilites)
+ app/Phoityne/IO/GUI/VSCode/TH/InitializeResponseJSON.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE TemplateHaskell #-}+++module Phoityne.IO.GUI.VSCode.TH.InitializeResponseJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.InitializeResponseCapabilitesJSON++-- |+--   Server-initiated response to client request+--+data InitializeResponse =+  InitializeResponse {+    seqInitializeResponse         :: Int     -- Sequence number+  , typeInitializeResponse        :: String  -- One of "request", "response", or "event"+  , request_seqInitializeResponse :: Int     -- Sequence number of the corresponding request+  , successInitializeResponse     :: Bool    -- Outcome of the request+  , commandInitializeResponse     :: String  -- The command requested +  , messageInitializeResponse     :: String  -- Contains error message if success == false.+  , bodyInitializeResponse        :: InitializeResponseCapabilites  -- The capabilities of this debug adapter+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "InitializeResponse") } ''InitializeResponse)
+ app/Phoityne/IO/GUI/VSCode/TH/InitializedEventJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.InitializedEventJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Server-initiated response to client request+--+data InitializedEvent =+  InitializedEvent {+    seqInitializedEvent   :: Int     -- Sequence number+  , typeInitializedEvent  :: String  -- One of "request", "response", or "event"+  , eventInitializedEvent :: String  -- Type of event+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "InitializedEvent") } ''InitializedEvent)++defaultInitializedEvent :: Int -> InitializedEvent+defaultInitializedEvent resSeq = InitializedEvent resSeq "event" "initialized"
+ app/Phoityne/IO/GUI/VSCode/TH/LaunchRequestArgumentsJSON.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.LaunchRequestArgumentsJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Arguments for "launch" request.+--+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.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "LaunchRequestArguments") } ''LaunchRequestArguments)+
+ app/Phoityne/IO/GUI/VSCode/TH/LaunchRequestJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.LaunchRequestJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.LaunchRequestArgumentsJSON++-- |+--   Launch request; value of command field is "launch".+--+data LaunchRequest =+  LaunchRequest {+    seqLaunchRequest       :: Int                     -- Sequence number+  , typeLaunchRequest      :: String                  -- One of "request", "response", or "event"+  , commandLaunchRequest   :: String                  -- The command to execute+  , argumentsLaunchRequest :: LaunchRequestArguments  -- Arguments for "launch" request.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "LaunchRequest") } ''LaunchRequest)+
+ app/Phoityne/IO/GUI/VSCode/TH/LaunchResponseJSON.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.LaunchResponseJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.LaunchRequestJSON++-- |+--   Server-initiated response to client request+--+data LaunchResponse =+  LaunchResponse {+    seqLaunchResponse         :: Int     -- Sequence number+  , typeLaunchResponse        :: String  -- One of "request", "response", or "event"+  , request_seqLaunchResponse :: Int     -- Sequence number of the corresponding request+  , successLaunchResponse     :: Bool    -- Outcome of the request+  , commandLaunchResponse     :: String  -- The command requested +  , messageLaunchResponse     :: String  -- Contains error message if success == false.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "LaunchResponse") } ''LaunchResponse)+++-- |+--+defaultLaunchResponse :: Int -> LaunchRequest ->  LaunchResponse+defaultLaunchResponse seq (LaunchRequest reqSeq _ _ _) =+  LaunchResponse seq "response" reqSeq True "launch" ""+++
+ app/Phoityne/IO/GUI/VSCode/TH/MessageJSON.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.MessageJSON where++import Data.Aeson+import Data.Aeson.TH+import qualified Data.Map as MAP++import Phoityne.Utility++-- |+--   A structured message object. Used to return errors from requests.+--+data Message =+  Message {+    idMessage            :: Int                    -- Unique identifier for the message.+  , formatMessage        :: String                 -- A format string for the message. Embedded variables have the form '{name}'. If variable name starts with an underscore character, the variable does not contain user data (PII) and can be safely used for telemetry purposes. +  , variablesMessage     :: MAP.Map String String  -- An object used as a dictionary for looking up the variables in the format string.  +  , sendTelemetryMessage :: Bool                   -- if true send to telemetry+  , showUserMessage      :: Bool                   -- if true show user+  , urlMessage           :: Maybe String           -- An optional url where additional information about this message can be found.+  , urlLabelMessage      :: Maybe String           -- An optional label that is presented to the user as the UI for opening the url. +  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "Message") } ''Message)++defaultMessage :: Message+defaultMessage = Message 0 "" (MAP.fromList []) False False Nothing Nothing+
+ app/Phoityne/IO/GUI/VSCode/TH/NextArgumentsJSON.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.NextArgumentsJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Arguments for "next" request.+--+data NextArguments =+  NextArguments {+    threadIdNextArguments :: Int --  Continue execution for this thread.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "NextArguments") } ''NextArguments)
+ app/Phoityne/IO/GUI/VSCode/TH/NextRequestJSON.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.NextRequestJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.NextArgumentsJSON++-- |+--   Next request; value of command field is "next".+--   The request starts the debuggee to run again for one step.+--   penDebug will respond with a StoppedEvent (event type 'step') after running the step.+--+data NextRequest =+  NextRequest {+    seqNextRequest       :: Int            -- Sequence number+  , typeNextRequest      :: String         -- One of "request", "response", or "event"+  , commandNextRequest   :: String         -- The command to execute+  , argumentsNextRequest :: NextArguments  -- Arguments for "disconnect" request.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "NextRequest") } ''NextRequest)
+ app/Phoityne/IO/GUI/VSCode/TH/NextResponseJSON.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.NextResponseJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.NextRequestJSON++-- |+--   Response to "next" request. This is just an acknowledgement, so no body field is required.+--+data NextResponse =+  NextResponse {+    seqNextResponse         :: Int     -- Sequence number+  , typeNextResponse        :: String  -- One of "request", "response", or "event"+  , request_seqNextResponse :: Int     -- Sequence number of the corresponding request+  , successNextResponse     :: Bool    -- Outcome of the request+  , commandNextResponse     :: String  -- The command requested +  , messageNextResponse     :: String  -- Contains error message if success == false.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "NextResponse") } ''NextResponse)++-- |+--+defaultNextResponse :: Int -> NextRequest ->  NextResponse+defaultNextResponse seq (NextRequest reqSeq _ _ _) =+  NextResponse seq "response" reqSeq True "next" ""++++
+ app/Phoityne/IO/GUI/VSCode/TH/OutputEventBodyJSON.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.OutputEventBodyJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Event message for "output" event type. The event indicates that the target has produced output.+--+data OutputEventBody =+  OutputEventBody {+    categoryOutputEventBody :: String        -- The category of output (such as: 'console', 'stdout', 'stderr', 'telemetry'). If not specified, 'console' is assumed. +  , outputOutputEventBody   :: String        -- The output to report.+  , dataOutputEventBody     :: Maybe String  -- Optional data to report. For the 'telemetry' category the data will be sent to telemetry, for the other categories the data is shown in JSON format.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "OutputEventBody") } ''OutputEventBody)++defaultOutputEventBody :: OutputEventBody+defaultOutputEventBody = OutputEventBody "console" "" Nothing++
+ app/Phoityne/IO/GUI/VSCode/TH/OutputEventJSON.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE TemplateHaskell     #-}++module Phoityne.IO.GUI.VSCode.TH.OutputEventJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.OutputEventBodyJSON++-- |+--   Event message for "output" event type. The event indicates that the target has produced output.+--+data OutputEvent =+  OutputEvent {+    seqOutputEvent   :: Int     -- Sequence number+  , typeOutputEvent  :: String  -- One of "request", "response", or "event"+  , eventOutputEvent :: String  -- Type of event+  , bodyOutputEvent  :: OutputEventBody +  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "OutputEvent") } ''OutputEvent)++defaultOutputEvent :: Int -> OutputEvent+defaultOutputEvent resSeq = OutputEvent resSeq "event" "output" defaultOutputEventBody+
+ app/Phoityne/IO/GUI/VSCode/TH/PauseArgumentsJSON.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.PauseArgumentsJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Arguments for "pause" request.+--+data PauseArguments =+  PauseArguments {+    threadIdPauseArguments :: Int --  Continue execution for this thread.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "PauseArguments") } ''PauseArguments)
+ app/Phoityne/IO/GUI/VSCode/TH/PauseRequestJSON.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.PauseRequestJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.PauseArgumentsJSON++-- |+--   Pause request; value of command field is "pause".+--   The request suspenses the debuggee.+--   penDebug will respond with a StoppedEvent (event type 'pause') after a successful 'pause' command.+--+data PauseRequest =+  PauseRequest {+    seqPauseRequest       :: Int             -- Sequence number+  , typePauseRequest      :: String          -- One of "request", "response", or "event"+  , commandPauseRequest   :: String          -- The command to execute+  , argumentsPauseRequest :: PauseArguments  -- Arguments for "pause" request.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "PauseRequest") } ''PauseRequest)
+ app/Phoityne/IO/GUI/VSCode/TH/PauseResponseJSON.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.PauseResponseJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.PauseRequestJSON++-- |+--  Response to "pause" request. This is just an acknowledgement, so no body field is required.+--+data PauseResponse =+  PauseResponse {+    seqPauseResponse         :: Int     -- Sequence number+  , typePauseResponse        :: String  -- One of "request", "response", or "event"+  , request_seqPauseResponse :: Int     -- Sequence number of the corresponding request+  , successPauseResponse     :: Bool    -- Outcome of the request+  , commandPauseResponse     :: String  -- The command requested +  , messagePauseResponse     :: String  -- Contains error message if success == false.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "PauseResponse") } ''PauseResponse)++-- |+--+defaultPauseResponse :: Int -> PauseRequest -> PauseResponse+defaultPauseResponse seq (PauseRequest reqSeq _ _ _) =+  PauseResponse seq "response" reqSeq True "pause" ""++
+ app/Phoityne/IO/GUI/VSCode/TH/RequestJSON.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE TemplateHaskell #-}++module Phoityne.IO.GUI.VSCode.TH.RequestJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Client-initiated request+--+data Request =+  Request {+    commandRequest   :: String    -- The command to execute+  -- , argumentsRequest :: [String]  -- Object containing arguments for the command+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "Request") } ''Request)
+ app/Phoityne/IO/GUI/VSCode/TH/ScopeJSON.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.ScopeJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   A Scope is a named container for variables.+--+data Scope =+  Scope {+    nameScope               :: String  -- name of the scope (as such 'Arguments', 'Locals')+  , variablesReferenceScope :: Int     -- The variables of this scope can be retrieved by passing the value of variablesReference to the VariablesRequest. +  , expensiveScope          :: Bool    -- If true, the number of variables in this scope is large or expensive to retrieve. +  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "Scope") } ''Scope)
+ app/Phoityne/IO/GUI/VSCode/TH/ScopesArgumentsJSON.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.ScopesArgumentsJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Arguments for "scopes" request.+--+data ScopesArguments =+  ScopesArguments {+    frameIdScopesArguments :: Int  -- Retrieve the scopes for this stackframe.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "ScopesArguments") } ''ScopesArguments)
+ app/Phoityne/IO/GUI/VSCode/TH/ScopesBodyJSON.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.ScopesBodyJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.ScopeJSON++-- |+--   Response to "scopes" request.+--+data ScopesBody =+  ScopesBody {+    scopesScopesBody :: [Scope]  -- The scopes of the stackframe. If the array has length zero, there are no scopes available.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "ScopesBody") } ''ScopesBody)++defaultScopesBody :: ScopesBody+defaultScopesBody = ScopesBody [Scope "GHCi scope" 1 False]+
+ app/Phoityne/IO/GUI/VSCode/TH/ScopesRequestJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.ScopesRequestJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.ScopesArgumentsJSON++-- |+--   Scopes request; value of command field is "scopes".+--   The request returns the variable scopes for a given stackframe ID.+--+data ScopesRequest =+  ScopesRequest {+    seqScopesRequest       :: Int              -- Sequence number+  , typeScopesRequest      :: String           -- One of "request", "response", or "event"+  , commandScopesRequest   :: String           -- The command to execute+  , argumentsScopesRequest :: ScopesArguments  -- Arguments for "scopes" request.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "ScopesRequest") } ''ScopesRequest)
+ app/Phoityne/IO/GUI/VSCode/TH/ScopesResponseJSON.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.ScopesResponseJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.ScopesBodyJSON+import Phoityne.IO.GUI.VSCode.TH.ScopesRequestJSON++-- |+--  Response to "scopes" request.+--+data ScopesResponse =+  ScopesResponse {+    seqScopesResponse         :: Int     -- Sequence number+  , typeScopesResponse        :: String  -- One of "request", "response", or "event"+  , request_seqScopesResponse :: Int     -- Sequence number of the corresponding request+  , successScopesResponse     :: Bool    -- Outcome of the request+  , commandScopesResponse     :: String  -- The command requested +  , messageScopesResponse     :: String  -- Contains error message if success == false.+  , bodyScopesResponse        :: ScopesBody+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "ScopesResponse") } ''ScopesResponse)+++-- |+--+defaultScopesResponse :: Int -> ScopesRequest -> ScopesResponse+defaultScopesResponse seq (ScopesRequest reqSeq _ _ _) =+  ScopesResponse seq "response" reqSeq True "scopes" "" defaultScopesBody++
+ app/Phoityne/IO/GUI/VSCode/TH/SetBreakpointsRequestArgumentsJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.SetBreakpointsRequestArgumentsJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.SourceJSON+import Phoityne.IO.GUI.VSCode.TH.SourceBreakpointJSON++-- |+--   Arguments for "setBreakpoints" request.+--+data SetBreakpointsRequestArguments =+  SetBreakpointsRequestArguments {+    sourceSetBreakpointsRequestArguments      :: Source              --  The source location of the breakpoints; either source.path or source.reference must be specified.+  , breakpointsSetBreakpointsRequestArguments :: [SourceBreakpoint]  -- The code locations of the breakpoints.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "SetBreakpointsRequestArguments") } ''SetBreakpointsRequestArguments)+
+ app/Phoityne/IO/GUI/VSCode/TH/SetBreakpointsRequestJSON.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.SetBreakpointsRequestJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.SetBreakpointsRequestArgumentsJSON++-- |+--   SetBreakpoints request; value of command field is "setBreakpoints".+--   Sets multiple breakpoints for a single source and clears all previous breakpoints in that source.+--   To clear all breakpoint for a source, specify an empty array.+--   When a breakpoint is hit, a StoppedEvent (event type 'breakpoint') is generated.+--+data SetBreakpointsRequest =+  SetBreakpointsRequest {+    seqSetBreakpointsRequest       :: Int                             -- Sequence number+  , typeSetBreakpointsRequest      :: String                          -- One of "request", "response", or "event"+  , commandSetBreakpointsRequest   :: String                          -- The command to execute+  , argumentsSetBreakpointsRequest :: SetBreakpointsRequestArguments  -- Arguments for "setBreakpoints" request.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "SetBreakpointsRequest") } ''SetBreakpointsRequest)
+ app/Phoityne/IO/GUI/VSCode/TH/SetBreakpointsResponseBodyJSON.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.SetBreakpointsResponseBodyJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.BreakpointJSON++-- |+--   Response to "setBreakpoints" request.+--   Returned is information about each breakpoint created by this request.+--   This includes the actual code location and whether the breakpoint could be verified.+--   The breakpoints returned are in the same order as the elements of the 'breakpoints'+--   (or the deprecated 'lines') in the SetBreakpointsArguments.+--+data SetBreakpointsResponseBody =+  SetBreakpointsResponseBody {+    breakpoints :: [Breakpoint]  -- Information about the breakpoints. The array elements are in the same order as the elements of the 'breakpoints' (or the deprecated 'lines') in the SetBreakpointsArguments.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "SetBreakpointsResponseBody") } ''SetBreakpointsResponseBody)++-- |+--+defaultSetBreakpointsResponseBody :: SetBreakpointsResponseBody+defaultSetBreakpointsResponseBody = SetBreakpointsResponseBody []++++
+ app/Phoityne/IO/GUI/VSCode/TH/SetBreakpointsResponseJSON.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.SetBreakpointsResponseJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.SetBreakpointsRequestJSON+import Phoityne.IO.GUI.VSCode.TH.SetBreakpointsResponseBodyJSON++-- |+--   Response to "setBreakpoints" request.+--   Returned is information about each breakpoint created by this request.+--   This includes the actual code location and whether the breakpoint could be verified.+--   The breakpoints returned are in the same order as the elements of the 'breakpoints'+--   (or the deprecated 'lines') in the SetBreakpointsArguments.+--+data SetBreakpointsResponse =+  SetBreakpointsResponse {+    seqSetBreakpointsResponse         :: Int     -- Sequence number+  , typeSetBreakpointsResponse        :: String  -- One of "request", "response", or "event"+  , request_seqSetBreakpointsResponse :: Int     -- Sequence number of the corresponding request+  , successSetBreakpointsResponse     :: Bool    -- Outcome of the request+  , commandSetBreakpointsResponse     :: String  -- The command requested +  , messageSetBreakpointsResponse     :: String  -- Contains error message if success == false.+  , bodySetBreakpointsResponse        :: SetBreakpointsResponseBody+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "SetBreakpointsResponse") } ''SetBreakpointsResponse)+++-- |+--+defaultSetBreakpointsResponse :: Int -> SetBreakpointsRequest ->  SetBreakpointsResponse+defaultSetBreakpointsResponse seq (SetBreakpointsRequest reqSeq _ _ _) =+  SetBreakpointsResponse seq "response" reqSeq True "setBreakpoints" "" defaultSetBreakpointsResponseBody++
+ app/Phoityne/IO/GUI/VSCode/TH/SourceArgumentsJSON.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.SourceArgumentsJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Arguments for "source" request.+--+data SourceArguments =+  SourceArguments {+    sourceReferenceSourceArguments :: Int --  The reference to the source. This is the value received in Source.reference.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "SourceArguments") } ''SourceArguments)
+ app/Phoityne/IO/GUI/VSCode/TH/SourceBreakpointJSON.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE TemplateHaskell     #-}++module Phoityne.IO.GUI.VSCode.TH.SourceBreakpointJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Properties of a breakpoint passed to the setBreakpoints request.+--+data SourceBreakpoint =+  SourceBreakpoint {+    lineSourceBreakpoint      :: Int           -- The source line of the breakpoint. +  , columnSourceBreakpoint    :: Maybe Int     -- An optional source column of the breakpoint.+  , conditionSourceBreakpoint :: Maybe String  --  An optional expression for conditional breakpoints.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "SourceBreakpoint") } ''SourceBreakpoint)++
+ app/Phoityne/IO/GUI/VSCode/TH/SourceJSON.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.SourceJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   A Source is a descriptor for source code. It is returned from the debug adapter as part of a StackFrame and it is used by clients when specifying breakpoints.+--+data Source =+  Source {+    nameSource            :: Maybe String  -- The short name of the source. Every source returned from the debug adapter has a name. When specifying a source to the debug adapter this name is optional.+  , pathSource            :: String  -- The long (absolute) path of the source. It is not guaranteed that the source exists at this location.+  , sourceReferenceSource :: Maybe Int     -- If sourceReference > 0 the contents of the source can be retrieved through the SourceRequest. A sourceReference is only valid for a session, so it must not be used to persist a source.+  , origineSource         :: Maybe String  -- The (optional) origin of this source: possible values "internal module", "inlined content from source map", etc.+  -- , adapterDataSource  :: Any     -- Optional data that a debug adapter might want to loop through the client. The client should leave the data intact and persist it across sessions. The client should not interpret the data.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "Source") } ''Source)
+ app/Phoityne/IO/GUI/VSCode/TH/SourceRequestJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.SourceRequestJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.SourceArgumentsJSON++-- |+--   Source request; value of command field is "source".+--   The request retrieves the source code for a given source reference.+--+data SourceRequest =+  SourceRequest {+    seqSourceRequest       :: Int              -- Sequence number+  , typeSourceRequest      :: String           -- One of "request", "response", or "event"+  , commandSourceRequest   :: String           -- The command to execute+  , argumentsSourceRequest :: SourceArguments  -- Arguments for "source" request.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "SourceRequest") } ''SourceRequest)
+ app/Phoityne/IO/GUI/VSCode/TH/SourceResponseBodyJSON.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.SourceResponseBodyJSON where++import Data.Aeson.TH++import Phoityne.Utility+++-- |+--    Response to "source" request. +--+data SourceResponseBody =+  SourceResponseBody {+    contentSourceResponseBody :: String  -- Content of the source reference+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "SourceResponseBody") } ''SourceResponseBody)+++-- |+--+defaultSourceResponseBody :: SourceResponseBody+defaultSourceResponseBody = SourceResponseBody ""++
+ app/Phoityne/IO/GUI/VSCode/TH/SourceResponseJSON.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.SourceResponseJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.SourceResponseBodyJSON+import Phoityne.IO.GUI.VSCode.TH.SourceRequestJSON++-- |+--  Response to "source" request. +--+data SourceResponse =+  SourceResponse {+    seqSourceResponse         :: Int     -- Sequence number+  , typeSourceResponse        :: String  -- One of "request", "response", or "event"+  , request_seqSourceResponse :: Int     -- Sequence number of the corresponding request+  , successSourceResponse     :: Bool    -- Outcome of the request+  , commandSourceResponse     :: String  -- The command requested +  , messageSourceResponse     :: String  -- Contains error message if success == false.+  , bodySourceResponse        :: SourceResponseBody+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "SourceResponse") } ''SourceResponse)++++-- |+--+defaultSourceResponse :: Int -> SourceRequest -> SourceResponse+defaultSourceResponse seq (SourceRequest reqSeq _ _ _) =+  SourceResponse seq "response" reqSeq True "source" "" defaultSourceResponseBody++
+ app/Phoityne/IO/GUI/VSCode/TH/StackFrameJSON.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.StackFrameJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.SourceJSON++-- |+--   A Stackframe contains the source location.+--+data StackFrame =+  StackFrame {+    idStackFrame     :: Int     -- An identifier for the stack frame. This id can be used to retrieve the scopes of the frame with the 'scopesRequest'.+  , nameStackFrame   :: String  -- The name of the stack frame, typically a method name.+  , sourceStackFrame :: Source  -- The optional source of the frame.+  , lineStackFrame   :: Int     -- The line within the file of the frame. If source is null or doesn't exist, line is 0 and must be ignored.+  , columnStackFrame :: Int     -- The column within the line. If source is null or doesn't exist, column is 0 and must be ignored.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "StackFrame") } ''StackFrame)
+ app/Phoityne/IO/GUI/VSCode/TH/StackTraceArgumentsJSON.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.StackTraceArgumentsJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Arguments for "stackTrace" request.+--+data StackTraceArguments =+  StackTraceArguments {+    threadIdStackTraceArguments   :: Int        --  Retrieve the stacktrace for this thread.+  , startFrameStackTraceArguments :: Maybe Int  -- The index of the first frame to return; if omitted frames start at 0.+  , levelsStackTraceArguments     :: Int        -- The maximum number of frames to return. If levels is not specified or 0, all frames are returned.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "StackTraceArguments") } ''StackTraceArguments)
+ app/Phoityne/IO/GUI/VSCode/TH/StackTraceBodyJSON.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.StackTraceBodyJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.StackFrameJSON++-- |+--   Body for "stackTrace" request.+--+data StackTraceBody =+  StackTraceBody {+    stackFramesStackTraceBody :: [StackFrame]  -- The frames of the stackframe. If the array has length zero, there are no stackframes available. This means that there is no location information available. +  , totalFramesStackTraceBody :: Int           -- The total number of frames available.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "StackTraceBody") } ''StackTraceBody)+++-- |+--+defaultStackTraceBody :: StackTraceBody+defaultStackTraceBody = StackTraceBody [] 0++
+ app/Phoityne/IO/GUI/VSCode/TH/StackTraceRequestJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.StackTraceRequestJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.StackTraceArgumentsJSON++-- |+--   StackTrace request; value of command field is "stackTrace".+--   The request returns a stacktrace from the current execution state.+--+data StackTraceRequest =+  StackTraceRequest {+    seqStackTraceRequest       :: Int                  -- Sequence number+  , typeStackTraceRequest      :: String               -- One of "request", "response", or "event"+  , commandStackTraceRequest   :: String               -- The command to execute+  , argumentsStackTraceRequest :: StackTraceArguments  -- Arguments for "stackTrace" request.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "StackTraceRequest") } ''StackTraceRequest)
+ app/Phoityne/IO/GUI/VSCode/TH/StackTraceResponseJSON.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.StackTraceResponseJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.StackTraceBodyJSON+import Phoityne.IO.GUI.VSCode.TH.StackTraceRequestJSON++-- |+--  Response to "stackTrace" request.+--+data StackTraceResponse =+  StackTraceResponse {+    seqStackTraceResponse         :: Int     -- Sequence number+  , typeStackTraceResponse        :: String  -- One of "request", "response", or "event"+  , request_seqStackTraceResponse :: Int     -- Sequence number of the corresponding request+  , successStackTraceResponse     :: Bool    -- Outcome of the request+  , commandStackTraceResponse     :: String  -- The command requested +  , messageStackTraceResponse     :: String  -- Contains error message if success == false.+  , bodyStackTraceResponse        :: StackTraceBody+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "StackTraceResponse") } ''StackTraceResponse)++-- |+--+defaultStackTraceResponse :: Int -> StackTraceRequest -> StackTraceResponse+defaultStackTraceResponse seq (StackTraceRequest reqSeq _ _ _) =+  StackTraceResponse seq "response" reqSeq True "stackTrace" "" defaultStackTraceBody++
+ app/Phoityne/IO/GUI/VSCode/TH/StepInArgumentsJSON.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.StepInArgumentsJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Arguments for "stepIn" request.+--+data StepInArguments =+  StepInArguments {+    threadIdStepInArguments :: Int --  Continue execution for this thread.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "StepInArguments") } ''StepInArguments)
+ app/Phoityne/IO/GUI/VSCode/TH/StepInRequestJSON.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.StepInRequestJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.StepInArgumentsJSON++-- |+--   StepIn request; value of command field is "stepIn".+--   The request starts the debuggee to run again for one step.+--   The debug adapter will respond with a StoppedEvent (event type 'step') after running the step.+--+data StepInRequest =+  StepInRequest {+    seqStepInRequest       :: Int              -- Sequence number+  , typeStepInRequest      :: String           -- One of "request", "response", or "event"+  , commandStepInRequest   :: String           -- The command to execute+  , argumentsStepInRequest :: StepInArguments  -- Arguments for "stepIn" request.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "StepInRequest") } ''StepInRequest)
+ app/Phoityne/IO/GUI/VSCode/TH/StepInResponseJSON.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.StepInResponseJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.StepInRequestJSON++-- |+--  Response to "stepIn" request. This is just an acknowledgement, so no body field is required.+--+data StepInResponse =+  StepInResponse {+    seqStepInResponse         :: Int     -- Sequence number+  , typeStepInResponse        :: String  -- One of "request", "response", or "event"+  , request_seqStepInResponse :: Int     -- Sequence number of the corresponding request+  , successStepInResponse     :: Bool    -- Outcome of the request+  , commandStepInResponse     :: String  -- The command requested +  , messageStepInResponse     :: String  -- Contains error message if success == false.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "StepInResponse") } ''StepInResponse)++-- |+--+defaultStepInResponse :: Int -> StepInRequest -> StepInResponse+defaultStepInResponse seq (StepInRequest reqSeq _ _ _) =+  StepInResponse seq "response" reqSeq True "stepIn" ""++
+ app/Phoityne/IO/GUI/VSCode/TH/StepOutArgumentsJSON.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.StepOutArgumentsJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Arguments for "stepOut" request.+--+data StepOutArguments =+  StepOutArguments {+    threadIdStepOutArguments :: Int --  Continue execution for this thread.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "StepOutArguments") } ''StepOutArguments)
+ app/Phoityne/IO/GUI/VSCode/TH/StepOutRequestJSON.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.StepOutRequestJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.StepOutArgumentsJSON++-- |+--   StepOutIn request; value of command field is "stepOut".+--   The request starts the debuggee to run again for one step.+--   penDebug will respond with a StoppedEvent (event type 'step') after running the step.+--+data StepOutRequest =+  StepOutRequest {+    seqStepOutRequest       :: Int               -- Sequence number+  , typeStepOutRequest      :: String            -- One of "request", "response", or "event"+  , commandStepOutRequest   :: String            -- The command to execute+  , argumentsStepOutRequest :: StepOutArguments  -- Arguments for "stepOut" request.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "StepOutRequest") } ''StepOutRequest)
+ app/Phoityne/IO/GUI/VSCode/TH/StepOutResponseJSON.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.StepOutResponseJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.StepOutRequestJSON++-- |+--  Response to "stepOut" request. This is just an acknowledgement, so no body field is required.+--+data StepOutResponse =+  StepOutResponse {+    seqStepOutResponse         :: Int     -- Sequence number+  , typeStepOutResponse        :: String  -- One of "request", "response", or "event"+  , request_seqStepOutResponse :: Int     -- Sequence number of the corresponding request+  , successStepOutResponse     :: Bool    -- Outcome of the request+  , commandStepOutResponse     :: String  -- The command requested +  , messageStepOutResponse     :: String  -- Contains error message if success == false.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "StepOutResponse") } ''StepOutResponse)+++-- |+--+defaultStepOutResponse :: Int -> StepOutRequest -> StepOutResponse+defaultStepOutResponse seq (StepOutRequest reqSeq _ _ _) =+  StepOutResponse seq "response" reqSeq True "stepOut" ""++++
+ app/Phoityne/IO/GUI/VSCode/TH/StoppedEventBodyJSON.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.StoppedEventBodyJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Event message for "stopped" event type.+--   The event indicates that the execution of the debuggee has stopped due to some condition.+--   This can be caused by a break point previously set, a stepping action has completed, by executing a debugger statement etc.+--+data StoppedEventBody =+  StoppedEventBody {+    reasonStoppedEventBody            :: String  -- The reason for the event (such as: 'step', 'breakpoint', 'exception', 'pause'). This string is shown in the UI.+  , threadIdStoppedEventBody          :: Int     -- The thread which was stopped.+  , textStoppedEventBody              :: String  -- Additional information. E.g. if reason is 'exception', text contains the exception name. This string is shown in the UI. ++  -- If allThreadsStopped is true, a debug adapter can announce that all threads have stopped.+  -- The client should use this information to enable that all threads can be expanded to access their stacktraces.+  -- If the attribute is missing or false, only the thread with the given threadId can be expanded.+  , allThreadsStoppedStoppedEventBody :: Bool+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "StoppedEventBody") } ''StoppedEventBody)++defaultStoppedEventBody :: StoppedEventBody+defaultStoppedEventBody = StoppedEventBody "breakpoint" 0 "" False+
+ app/Phoityne/IO/GUI/VSCode/TH/StoppedEventJSON.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.StoppedEventJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.StoppedEventBodyJSON++-- |+--   Event message for "stopped" event type.+--   The event indicates that the execution of the debuggee has stopped due to some condition.+--   This can be caused by a break point previously set, a stepping action has completed, by executing a debugger statement etc.+--+data StoppedEvent =+  StoppedEvent {+    seqStoppedEvent   :: Int     -- Sequence number+  , typeStoppedEvent  :: String  -- One of "request", "response", or "event"+  , eventStoppedEvent :: String  -- Type of event+  , bodyStoppedEvent  :: StoppedEventBody+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "StoppedEvent") } ''StoppedEvent)++defaultStoppedEvent :: Int -> StoppedEvent+defaultStoppedEvent seq = StoppedEvent seq "event" "stopped" defaultStoppedEventBody+
+ app/Phoityne/IO/GUI/VSCode/TH/TerminatedEventBodyJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.TerminatedEventBodyJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Event message for "terminated" event types.+-- The event indicates that debugging of the debuggee has terminated.+--+data TerminatedEventBody =+  TerminatedEventBody {+    restartTerminatedEventBody :: Bool  -- A debug adapter may set 'restart' to true to request that the front end restarts the session.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "TerminatedEventBody") } ''TerminatedEventBody)++defaultTerminatedEventBody :: TerminatedEventBody+defaultTerminatedEventBody = TerminatedEventBody False+
+ app/Phoityne/IO/GUI/VSCode/TH/TerminatedEventJSON.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.TerminatedEventJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.TerminatedEventBodyJSON++-- |+--   Event message for "terminated" event types.+--   The event indicates that debugging of the debuggee has terminated.+--+data TerminatedEvent =+  TerminatedEvent {+    seqTerminatedEvent   :: Int     -- Sequence number+  , typeTerminatedEvent  :: String  -- One of "request", "response", or "event"+  , eventTerminatedEvent :: String  -- Type of event+  , bodyTerminatedEvent  :: TerminatedEventBody+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "TerminatedEvent") } ''TerminatedEvent)++defaultTerminatedEvent :: Int -> TerminatedEvent+defaultTerminatedEvent seq = TerminatedEvent seq "event" "terminated" defaultTerminatedEventBody+
+ app/Phoityne/IO/GUI/VSCode/TH/ThreadJSON.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.ThreadJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   A Thread is a name/value pair.+--   If the value is structured (has children), a handle is provided to retrieve the children with the ThreadsRequest.+--+data Thread =+  Thread {+    idThread   :: Int     -- Unique identifier for the thread. +  , nameThread :: String  -- A name of the thread. +  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "Thread") } ''Thread)
+ app/Phoityne/IO/GUI/VSCode/TH/ThreadsRequestJSON.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.ThreadsRequestJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Thread request; value of command field is "threads".+--   The request retrieves a list of all threads.+--+data ThreadsRequest =+  ThreadsRequest {+    seqThreadsRequest       :: Int              -- Sequence number+  , typeThreadsRequest      :: String           -- One of "request", "response", or "event"+  , commandThreadsRequest   :: String           -- The command to execute+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "ThreadsRequest") } ''ThreadsRequest)
+ app/Phoityne/IO/GUI/VSCode/TH/ThreadsResponseBodyJSON.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.ThreadsResponseBodyJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.ThreadJSON++-- |+--    Response to "threads" request.+--+data ThreadsResponseBody =+  ThreadsResponseBody {+    threadsThreadsResponseBody :: [Thread]  -- All threads.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "ThreadsResponseBody") } ''ThreadsResponseBody)+++-- |+--+defaultThreadsResponseBody :: ThreadsResponseBody+defaultThreadsResponseBody = ThreadsResponseBody [Thread 0 "ghci main thread"]++
+ app/Phoityne/IO/GUI/VSCode/TH/ThreadsResponseJSON.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.ThreadsResponseJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.ThreadsResponseBodyJSON+import Phoityne.IO.GUI.VSCode.TH.ThreadsRequestJSON++-- |+--  Response to "threads" request. +--+data ThreadsResponse =+  ThreadsResponse {+    seqThreadsResponse         :: Int     -- Sequence number+  , typeThreadsResponse        :: String  -- One of "request", "response", or "event"+  , request_seqThreadsResponse :: Int     -- Sequence number of the corresponding request+  , successThreadsResponse     :: Bool    -- Outcome of the request+  , commandThreadsResponse     :: String  -- The command requested +  , messageThreadsResponse     :: String  -- Contains error message if success == false.+  , bodyThreadsResponse        :: ThreadsResponseBody+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "ThreadsResponse") } ''ThreadsResponse)++++-- |+--+defaultThreadsResponse :: Int -> ThreadsRequest -> ThreadsResponse+defaultThreadsResponse seq (ThreadsRequest reqSeq _ _) =+  ThreadsResponse seq "response" reqSeq True "threads" "" defaultThreadsResponseBody++++
+ app/Phoityne/IO/GUI/VSCode/TH/VariableJSON.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.VariableJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   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+  , 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.+  , variablesReferenceVariable :: Int     -- If variablesReference is > 0, the variable is structured and its children can be retrieved by passing variablesReference to the VariablesRequest.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "Variable") } ''Variable)
+ app/Phoityne/IO/GUI/VSCode/TH/VariablesArgumentsJSON.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.VariablesArgumentsJSON where++import Data.Aeson.TH++import Phoityne.Utility++-- |+--   Arguments for "variables" request.+--+data VariablesArguments =+  VariablesArguments {+    variablesReferenceVariablesArguments :: Int  -- The Variable reference. +  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "VariablesArguments") } ''VariablesArguments)
+ app/Phoityne/IO/GUI/VSCode/TH/VariablesBodyJSON.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.VariablesBodyJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.VariableJSON++-- |+--    Response to "variables" request. +--+data VariablesBody =+  VariablesBody {+    variablesVariablesBody :: [Variable]  -- All children for the given variable reference.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "VariablesBody") } ''VariablesBody)++-- |+--+defaultVariablesBody :: VariablesBody+defaultVariablesBody = VariablesBody []+
+ app/Phoityne/IO/GUI/VSCode/TH/VariablesRequestJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.VariablesRequestJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.VariablesArgumentsJSON++-- |+--   Variables request; value of command field is "variables".+--   Retrieves all children for the given variable reference.+--+data VariablesRequest =+  VariablesRequest {+    seqVariablesRequest       :: Int                 -- Sequence number+  , typeVariablesRequest      :: String              -- One of "request", "response", or "event"+  , commandVariablesRequest   :: String              -- The command to execute+  , argumentsVariablesRequest :: VariablesArguments  -- Arguments for "variables" request.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "VariablesRequest") } ''VariablesRequest)
+ app/Phoityne/IO/GUI/VSCode/TH/VariablesResponseJSON.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.IO.GUI.VSCode.TH.VariablesResponseJSON where++import Data.Aeson.TH++import Phoityne.Utility+import Phoityne.IO.GUI.VSCode.TH.VariablesBodyJSON+import Phoityne.IO.GUI.VSCode.TH.VariablesRequestJSON++-- |+--  Response to "variables" request. +--+data VariablesResponse =+  VariablesResponse {+    seqVariablesResponse         :: Int     -- Sequence number+  , typeVariablesResponse        :: String  -- One of "request", "response", or "event"+  , request_seqVariablesResponse :: Int     -- Sequence number of the corresponding request+  , successVariablesResponse     :: Bool    -- Outcome of the request+  , commandVariablesResponse     :: String  -- The command requested +  , messageVariablesResponse     :: String  -- Contains error message if success == false.+  , bodyVariablesResponse        :: VariablesBody+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "VariablesResponse") } ''VariablesResponse)++++-- |+--+defaultVariablesResponse :: Int -> VariablesRequest -> VariablesResponse+defaultVariablesResponse seq (VariablesRequest reqSeq _ _ _) =+  VariablesResponse seq "response" reqSeq True "variables" "" defaultVariablesBody+++
+ app/Phoityne/IO/Main.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE MultiWayIf          #-}++module Phoityne.IO.Main (run) where++-- モジュール+import Phoityne.Constant+import qualified Phoityne.Argument as A+import qualified Phoityne.IO.Control as CTRL++-- システム+import System.IO+import Data.Either.Utils+import Safe+import qualified Control.Exception as E+import qualified System.IO.Error as E+import qualified Data.ConfigFile as C+import qualified System.Console.CmdArgs as CMD+import qualified System.Log.Logger as L+import qualified System.Log.Formatter as L+import qualified System.Log.Handler as LH+import qualified System.Log.Handler.Simple as LHS++-- |+--  アプリケーションメイン+-- +run :: IO Int+run = flip E.catches handlers $ do++  -- コマンドライン引数設定+  args <- getArgs++  -- INI設定ファイルのRead+  iniSet <- loadIniFile args++  -- Loggerのセットアップ+  setupLogger iniSet++  -- ロジック実行+  flip E.finally finalProc $ do+    CTRL.run args iniSet++  where+    handlers = [ E.Handler helpExcept+               , E.Handler ioExcept+               , E.Handler someExcept+               ]+    finalProc = L.removeAllHandlers +    helpExcept (_ :: A.HelpExitException) = return 0+    ioExcept   (e :: E.IOException)       = print e >> return 1+    someExcept (e :: E.SomeException)     = print e >> return 1++-- |+--  引数データの取得+-- +getArgs :: IO A.ArgData+getArgs = E.catches (CMD.cmdArgs A.config) handlers+  where+    handlers = [E.Handler someExcept]+    someExcept (e :: E.SomeException) = if+      | "ExitSuccess" == show e -> E.throw A.HelpExitException+      | otherwise -> E.throwIO e++-- |+--  INI設定ファイルデータの取得+-- +loadIniFile :: A.ArgData          -- コマンドライン引数+            -> IO C.ConfigParser  -- INI設定+loadIniFile args = do+  cp <- if null (A.file args) then return $ forceEither $ C.readstring C.emptyCP defaultIniSetting+          else forceEither <$> C.readfile C.emptyCP (A.file args)++  return cp{ C.accessfunc = C.interpolatingAccess 5 }++-- |+-- デフォルトINI設定+-- +defaultIniSetting :: String+defaultIniSetting = unlines [+    "[DEFAULT]"+  , "work_dir = C:/temp/"+  , ""+  , "[LOG]"+  , "file  = %(work_dir)sphoityne.log"+  , "level = WARNING"+  , ""+  , "[PHOITYNE]"+  ]++-- |+--  Loggerのセットアップ+-- +setupLogger :: C.ConfigParser -- INI設定+            -> IO ()          -- なし+setupLogger cp = do+  let logFile  = forceEither $ C.get cp _INI_SEC_LOG _INI_LOG_FILE+      logLevel = forceEither $ C.get cp _INI_SEC_LOG _INI_LOG_LEVEL++  level <- case readMay logLevel of+    Just a  -> return a+    Nothing -> E.throwIO . E.userError $ "invalid log level[" ++ logLevel ++ "]"++  logStream <- openFile logFile AppendMode+  hSetEncoding logStream utf8++  logH <- LHS.streamHandler logStream level+  +  let logHandle  = logH {LHS.closeFunc = hClose}+      logFormat  = L.tfLogFormatter _LOG_FORMAT_DATE _LOG_FORMAT+      logHandler = LH.setFormatter logHandle logFormat++  L.updateGlobalLogger L.rootLoggerName $ L.setHandlers ([] :: [LHS.GenericHandler Handle])+  L.updateGlobalLogger _LOG_NAME $ L.setHandlers [logHandler]+  L.updateGlobalLogger _LOG_NAME $ L.setLevel level+
+ app/Phoityne/IO/Utility.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE MultiWayIf #-}++module Phoityne.IO.Utility where++-- システム+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as LBS+import GHC.IO.Encoding+import Distribution.System+import Control.Monad.Trans.Resource+import qualified Data.Conduit.Binary as C+import qualified Data.Conduit as C+import qualified Data.Conduit.List as C++-- |+--  +-- +getReadHandleEncoding :: IO TextEncoding+getReadHandleEncoding = if+  | Windows == buildOS -> mkTextEncoding "CP932//TRANSLIT"+  | otherwise -> mkTextEncoding "UTF-8//TRANSLIT"++-- |+--  +-- +loadFile :: FilePath -> IO B.ByteString+loadFile path = do+  bs <- runResourceT+      $ C.sourceFile path+      C.$$ C.consume+  return $ B.concat bs++-- |+--  +-- +saveFile :: FilePath -> B.ByteString -> IO ()+saveFile path cont = saveFileLBS path $ LBS.fromStrict cont++-- |+--  +-- +saveFileLBS :: FilePath -> LBS.ByteString -> IO ()+saveFileLBS path cont = runResourceT+  $ C.sourceLbs cont+  C.$$ C.sinkFile path+++
+ app/Phoityne/Utility.hs view
@@ -0,0 +1,74 @@++module Phoityne.Utility where++-- システム+import Data.Either.Utils+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.List as L+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TLE+import qualified Data.ConfigFile as CFG+import qualified Data.Tree as TR+++-- |+--  UTF8文字列をByteStringへの変換+--+str2bs :: String -> BS.ByteString+str2bs = TE.encodeUtf8 . T.pack++-- |+--  ByteStringをUTF8文字列への変換+--+bs2str :: BS.ByteString -> String+bs2str = T.unpack. TE.decodeUtf8++-- |+--  UTF8文字列をLazyByteStringへの変換+--+str2lbs :: String -> LBS.ByteString+str2lbs = TLE.encodeUtf8 . TL.pack++-- |+--  LazyByteStringをUTF8文字列への変換+--+lbs2str :: LBS.ByteString -> String+lbs2str = TL.unpack. TLE.decodeUtf8++-- |+--  INI設定の指定したセクションに含まれる+--  すべて設定項目を返す。+--+getIniItems :: CFG.ConfigParser+            -> CFG.SectionSpec+            -> [(CFG.OptionSpec, String)]+getIniItems cp sec = foldr go [] opts+  where+    opts = forceEither $ CFG.options cp sec+    go opt acc = let value = forceEither $ CFG.get cp sec opt in+                 (opt, value) : acc+++-- |+--  +-- +addChildTree :: TR.Tree a -> TR.Tree a -> TR.Tree a+addChildTree parent child = parent { TR.subForest = child : curForest}+  where curForest = TR.subForest parent+++-- |+--  +-- +pushWithLimit :: (Eq a, Ord a) => [a] -> a -> Int -> [a]+pushWithLimit [] item _ = [item]+pushWithLimit buf item maxSize = if length buf > maxSize then item : L.init buf else item : buf++-- |+--+rdrop :: Eq a => Int -> [a] -> [a]+rdrop cnt = reverse . drop cnt . reverse+
+ phoityne-vscode.cabal view
@@ -0,0 +1,139 @@+name:                phoityne-vscode+version:             0.0.1.0+synopsis:            ghci debug viewer on Visual Studio Code+description:         Please see README.md+license:             BSD3+license-file:        LICENSE+author:              phoityne_hs+maintainer:          phoityne.hs@gmail.com+homepage:            https://sites.google.com/site/phoityne/+copyright:           2016 phoityne_hs+category:            Development+build-type:          Simple+cabal-version:       >=1.10+extra-source-files:  README.md+                   , Changelog.md+data-files:          vscode/package.json++executable phoityne-vscode+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing+  hs-source-dirs:      app+  main-is:             Main.hs+  other-modules:       Paths_phoityne_vscode+                     , Phoityne.Argument+                     , Phoityne.Constant+                     , Phoityne.Utility+                     , Phoityne.IO.Control+                     , Phoityne.IO.Main+                     , Phoityne.IO.Utility+                     , Phoityne.IO.CUI.GHCiControl+                     , Phoityne.IO.GUI.Control+                     , Phoityne.IO.GUI.VSCode.TH.BreakpointJSON+                     , Phoityne.IO.GUI.VSCode.TH.ContinueArgumentsJSON+                     , Phoityne.IO.GUI.VSCode.TH.ContinueRequestJSON+                     , Phoityne.IO.GUI.VSCode.TH.ContinueResponseJSON+                     , Phoityne.IO.GUI.VSCode.TH.DisconnectArgumentsJSON+                     , Phoityne.IO.GUI.VSCode.TH.DisconnectRequestJSON+                     , Phoityne.IO.GUI.VSCode.TH.DisconnectResponseJSON+                     , Phoityne.IO.GUI.VSCode.TH.ErrorResponseBodyJSON+                     , Phoityne.IO.GUI.VSCode.TH.ErrorResponseJSON+                     , Phoityne.IO.GUI.VSCode.TH.EvaluateArgumentsJSON+                     , Phoityne.IO.GUI.VSCode.TH.EvaluateBodyJSON+                     , Phoityne.IO.GUI.VSCode.TH.EvaluateRequestJSON+                     , Phoityne.IO.GUI.VSCode.TH.EvaluateResponseJSON+                     , Phoityne.IO.GUI.VSCode.TH.ExceptionBreakpointsFilterJSON+                     , Phoityne.IO.GUI.VSCode.TH.ExitedEventBodyJSON+                     , Phoityne.IO.GUI.VSCode.TH.ExitedEventJSON+                     , Phoityne.IO.GUI.VSCode.TH.InitializedEventJSON+                     , Phoityne.IO.GUI.VSCode.TH.InitializeRequestArgumentsJSON+                     , Phoityne.IO.GUI.VSCode.TH.InitializeRequestJSON+                     , Phoityne.IO.GUI.VSCode.TH.InitializeResponseCapabilitesJSON+                     , Phoityne.IO.GUI.VSCode.TH.InitializeResponseJSON+                     , Phoityne.IO.GUI.VSCode.TH.LaunchRequestArgumentsJSON+                     , Phoityne.IO.GUI.VSCode.TH.LaunchRequestJSON+                     , Phoityne.IO.GUI.VSCode.TH.LaunchResponseJSON+                     , Phoityne.IO.GUI.VSCode.TH.MessageJSON+                     , Phoityne.IO.GUI.VSCode.TH.NextArgumentsJSON+                     , Phoityne.IO.GUI.VSCode.TH.NextRequestJSON+                     , Phoityne.IO.GUI.VSCode.TH.NextResponseJSON+                     , Phoityne.IO.GUI.VSCode.TH.OutputEventJSON+                     , Phoityne.IO.GUI.VSCode.TH.OutputEventBodyJSON+                     , Phoityne.IO.GUI.VSCode.TH.PauseArgumentsJSON+                     , Phoityne.IO.GUI.VSCode.TH.PauseRequestJSON+                     , Phoityne.IO.GUI.VSCode.TH.PauseResponseJSON+                     , Phoityne.IO.GUI.VSCode.TH.RequestJSON+                     , Phoityne.IO.GUI.VSCode.TH.ScopeJSON+                     , Phoityne.IO.GUI.VSCode.TH.ScopesArgumentsJSON+                     , Phoityne.IO.GUI.VSCode.TH.ScopesBodyJSON+                     , Phoityne.IO.GUI.VSCode.TH.ScopesRequestJSON+                     , Phoityne.IO.GUI.VSCode.TH.ScopesResponseJSON+                     , Phoityne.IO.GUI.VSCode.TH.SetBreakpointsRequestArgumentsJSON+                     , Phoityne.IO.GUI.VSCode.TH.SetBreakpointsRequestJSON+                     , Phoityne.IO.GUI.VSCode.TH.SetBreakpointsResponseBodyJSON+                     , Phoityne.IO.GUI.VSCode.TH.SetBreakpointsResponseJSON+                     , Phoityne.IO.GUI.VSCode.TH.SourceArgumentsJSON+                     , Phoityne.IO.GUI.VSCode.TH.SourceBreakpointJSON+                     , Phoityne.IO.GUI.VSCode.TH.SourceJSON+                     , Phoityne.IO.GUI.VSCode.TH.SourceRequestJSON+                     , Phoityne.IO.GUI.VSCode.TH.SourceResponseBodyJSON+                     , Phoityne.IO.GUI.VSCode.TH.SourceResponseJSON+                     , Phoityne.IO.GUI.VSCode.TH.StackFrameJSON+                     , Phoityne.IO.GUI.VSCode.TH.StackTraceArgumentsJSON+                     , Phoityne.IO.GUI.VSCode.TH.StackTraceBodyJSON+                     , Phoityne.IO.GUI.VSCode.TH.StackTraceRequestJSON+                     , Phoityne.IO.GUI.VSCode.TH.StackTraceResponseJSON+                     , Phoityne.IO.GUI.VSCode.TH.StepInArgumentsJSON+                     , Phoityne.IO.GUI.VSCode.TH.StepInRequestJSON+                     , Phoityne.IO.GUI.VSCode.TH.StepInResponseJSON+                     , Phoityne.IO.GUI.VSCode.TH.StepOutArgumentsJSON+                     , Phoityne.IO.GUI.VSCode.TH.StepOutRequestJSON+                     , Phoityne.IO.GUI.VSCode.TH.StepOutResponseJSON+                     , Phoityne.IO.GUI.VSCode.TH.StoppedEventBodyJSON+                     , Phoityne.IO.GUI.VSCode.TH.StoppedEventJSON+                     , Phoityne.IO.GUI.VSCode.TH.TerminatedEventBodyJSON+                     , Phoityne.IO.GUI.VSCode.TH.TerminatedEventJSON+                     , Phoityne.IO.GUI.VSCode.TH.ThreadJSON+                     , Phoityne.IO.GUI.VSCode.TH.ThreadsRequestJSON+                     , Phoityne.IO.GUI.VSCode.TH.ThreadsResponseBodyJSON+                     , Phoityne.IO.GUI.VSCode.TH.ThreadsResponseJSON+                     , Phoityne.IO.GUI.VSCode.TH.VariableJSON+                     , Phoityne.IO.GUI.VSCode.TH.VariablesArgumentsJSON+                     , Phoityne.IO.GUI.VSCode.TH.VariablesBodyJSON+                     , Phoityne.IO.GUI.VSCode.TH.VariablesRequestJSON+                     , Phoityne.IO.GUI.VSCode.TH.VariablesResponseJSON+  build-depends:       base >= 4.7 && < 5+                     , directory+                     , Cabal+                     , hslogger+                     , ConfigFile+                     , cmdargs+                     , MissingH+                     , safe+                     , aeson+                     , bytestring+                     , containers+                     , conduit+                     , conduit-extra+                     , text+                     , resourcet+                     , process+                     , HStringTemplate+                     , transformers+                     , mtl+                     , filepath+                     , directory+                     , parsec+                     , split+  default-language:    Haskell2010++test-suite phoityne-vscode-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , aeson+                     , hspec+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ vscode/package.json view
@@ -0,0 +1,47 @@+{+	"name":        "phoityne-vscode",+	"displayName": "phoityne",+	"version":     "0.0.1",+	"publisher":   "phoityne.hs",+	"description": "ghci debug viewer Phoityne, on Visual Studio Code.",+	"categories":  ["Debuggers"],+	"author":      {"name": "phoityne.hs"},+	"license": "BSD3",+	"private": false,+	"engines": {"vscode": "^0.10.1"},+	"dependencies": {},+	"contributes": {+		"debuggers": [{+			"type": "ghc",+			"label": "ghci debug viewer Phoityne",+			"enableBreakpointsFor": { "languageIds": ["haskell"] },+			"program": "phoityne-vscode.exe",+			"configurationAttributes": {+				"launch": {+					"required": ["program"],+					"properties": {+						"workspace": {+							"type"       : "string",+							"description": "Absolute path to the workspace.",+							"default"    : "${workspaceRoot}"+						},+						"startup": {+							"type": "string",+							"description": "Absolute path to the startup program.",+							"default": "${workspaceRoot}/test/Spec.hs"+						}+					}+				}+			},+			"initialConfigurations": [+				{+					"type": "ghc",+					"name": "ghci debug viewer Phoityne",+					"request": "launch",+					"workspace": "${workspaceRoot}",+					"startup": "${workspaceRoot}/test/Spec.hs"+				}+			]+		}]+	}+}