packages feed

phoityne-vscode 0.0.7.0 → 0.0.8.0

raw patch · 174 files changed

+5158/−4625 lines, 174 filesdep −hspecdep ~base

Dependencies removed: hspec

Dependency ranges changed: base

Files

Changelog.md view
@@ -1,4 +1,8 @@ +20160804 phoityne-vscode-0.0.8.0+  * [Modify] モジュール構成の変更。+  * [Modify] debugger adopter interface Capabilitiesの変更に対応した。+ 20160704 phoityne-vscode-0.0.7.0   * [Modify] debugger adopter interface Capabilitiesの変更に対応した。   * [Modify] debugger adopter interface StackFrameの変更に対応した。(endLin, endColumnの追加)
README.md view
@@ -55,6 +55,61 @@ 1. ctrlr + p on Visual Studio Code 2. ext install haskell ...  3. select "[Haskell GHCi debug viewer Phoityne](https://marketplace.visualstudio.com/items?itemName=phoityne.phoityne-vscode)"+## Capabilites +* supportsConfigurationDoneRequest : no+* supportsFunctionBreakpoints : no+* supportsConditionalBreakpoints : yes+* supportsEvaluateForHovers : yes+* exceptionBreakpointFilters : no+* supportsStepBack : no+* supportsSetVariable : no+* supportsRestartFrame : no+++## Configuration++### .vscode/launch.json++* startup+  * required+  * default : ${workspaceRoot}/test/Spec.hs+  * debug startup file, will be loaded automatically.+* ghciCmd+  * required+  * default: stack ghci --test --no-load --no-build+  * launch ghci command, must be Prelude module loaded.  +    For example, "ghci -i${workspaceRoot}/src", "cabal exec -- ghci -i${workspaceRoot}/src"+* ghciPrompt+  * required+  * default: H>>= +  * ghci command prompt string.+* logFile+  * required+  * default: ${workspaceRoot}/.vscode/phoityne.log+  * internal log file.+* logLevel+  * required+  * default: WARNING+  * internal log level.++### .vscode/tasks.json++* stack build+  * required+  * default: stack build+  * task definition for F6 shortcut key.+* stack clean & build+  * required+  * default: stack clean && stack build+  * task definition for F7 shortcut key.+* stack test+  * required+  * default: stack test+  * task definition for F8 shortcut key.+* stack watch+  * required+  * default: stack build --test --no-run-tests --file-watch+  * task definition for F6 shortcut key.
app/Main.hs view
@@ -4,7 +4,7 @@ module Main where  -- モジュール-import qualified Phoityne.IO.Main as M+import qualified Phoityne.VSCode.IO.Main as M  -- システム import System.Exit
− app/Phoityne/Argument.hs 
@@ -1,65 +0,0 @@-{-# 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--import Paths_phoityne_vscode (version)-import Data.Version (showVersion)---- |---  ヘルプ表示時の例外----data HelpExitException = HelpExitException-                       deriving (Show, Typeable)--instance E.Exception HelpExitException---- |---  コマンドライン引数データ設定---    モードを使用する場合のサンプル----data ArgData = ModeA deriving (Data, Typeable, Show, Read, Eq)---- |---  アノテーション設定----config :: ArgData-config = modes [confA]-         &= summary sumMsg-         &= program "phoityne-vscode"-         -  where-    confA = ModeA {--          } &= name "ModeA"-            &= details mdAMsg-            &= auto--    sumMsg = unlines [-             "phoityne-vscode-" ++ showVersion version-           ]-           -    mdAMsg = [-             ""-           , "Phoityne is a ghci debug viewer for Visual Studio Code. "-           , ""-           ]----- |---  enum値引数----data Method = Get | Post | Put | Delete-              deriving (Data, Typeable, Show, Read, Eq)--
− app/Phoityne/Constant.hs 
@@ -1,74 +0,0 @@--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/GHCi.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE GADTs               #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE MultiWayIf          #-}+{-# LANGUAGE BinaryLiterals      #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable  #-}++module Phoityne.GHCi (+  module Phoityne.GHCi.IO.Process+, module Phoityne.GHCi.IO.Command+) where++import Phoityne.GHCi.IO.Process+import Phoityne.GHCi.IO.Command+
+ app/Phoityne/GHCi/IO/Command.hs view
@@ -0,0 +1,593 @@+{-# LANGUAGE GADTs               #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE MultiWayIf          #-}+{-# LANGUAGE BinaryLiterals      #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable  #-}++module Phoityne.GHCi.IO.Command (+    SourcePosition(..)+  , StackFrame(..)+  , BindingData(..)+  , start+  , quit+  , set+  , loadFile+  , loadModule+  , setBreak+  , setFuncBreak+  , delete+  , traceMain+  , trace+  , step+  , stepLocal+  , history+  , back+  , forward+  , bindings+  , force+  , info+  , showType+  , showKind+  , execBool+  , exec+  ) where++import Phoityne.GHCi.IO.Process+import Text.Parsec+import Data.Functor.Identity+import Data.Char+import qualified Data.List as L+import qualified System.Exit as S+import qualified Data.String.Utils as U+++-- |+--+_HS_FILE_EXT :: String+_HS_FILE_EXT = ".hs"++-- |+--+_GHCI_PROMPT :: String+_GHCI_PROMPT = "Prelude> "+++-- |+--+type OutputHandler = String -> IO ()++-- |+--+type GHCiCommand = String++-- |+--+type GHCiOption = String++-- |+--+type ModuleName = String++-- |+--+type LineNo = Int++-- |+--+type BreakId = Int++-- |+--+data SourcePosition = SourcePosition {+    filePathSourcePosition    :: FilePath+  , startLineNoSourcePosition :: Int+  , startColNoSourcePosition  :: Int+  , endLineNoSourcePosition   :: Int+  , endColNoSourcePosition    :: Int+  } deriving (Show, Read, Eq, Ord)++-- |+--+data StackFrame = StackFrame {+    idStackFrame       :: Int+  , functionStackFrame :: String+  , positionStackFrame :: SourcePosition+  } deriving (Show, Read, Eq, Ord)+++-- |+--+data BindingData = BindingData {+    nameBindingData  :: String+  , typeBindingData  :: String+  , valueBindingData :: String+  } deriving (Show, Read, Eq, Ord)+++-- |+--+start :: OutputHandler+      -> GHCiCommand+      -> [GHCiOption]+      -> FilePath+      -> String+      -> IO (Either ErrorData GHCiProcess)+start outHdl cmd opts cwd pmt = do+  outHdl $ L.intercalate " " $ (cmd : opts) ++ ["in " ++ cwd, "\n"]+  runProcess cmd opts cwd pmt >>= withProcess+  where+    withProcess (Left err) = return $ Left err+    withProcess (Right ghci) = readCharWhile ghci (not.endOfStartMsg) >>= setupGHCi ghci++    setupGHCi _  (Left err) = return $ Left err+    setupGHCi ghci@(GHCiProcess _ _ _ _ pmt) (Right msg) = do+      outHdl msg+      set ghci outHdl ("prompt \"" ++ pmt ++ "\"") >>= \case+        Left err -> return $ Left err+        Right _  -> set ghci outHdl "-fprint-evld-with-show" >>= \case+          Left err -> return $ Left err+          Right _  -> return $ Right ghci++    endOfStartMsg msg+      | U.endswith _GHCI_PROMPT msg = True+      | endOfModLoadPrompt (last (lines msg)) = True+      | otherwise = False++    endOfModLoadPrompt str = case parse endOfModLoadPromptParser "endOfModLoadPrompt" str of+      Right _ -> True+      Left _  -> False++    endOfModLoadPromptParser = do+      char '*' >> manyTill anyChar (char '>') >> space >> eof+      return True++-- |+--+quit :: GHCiProcess -> OutputHandler -> IO (Either ErrorData S.ExitCode)+quit ghci outHdl = do+  let cmd = ":quit"+  outHdl $ cmd ++ "\n"++  writeLine ghci cmd >>= \case+    Left err -> return $ Left err+    Right _ -> readTillEOF ghci >>= \case+      Left err -> return $ Left err+      Right msg -> do+        outHdl msg+        exitProcess ghci+++-- |+--+set :: GHCiProcess -> OutputHandler -> String -> IO (Either ErrorData ())+set ghci outHdl cmdArg = do+  let cmd = ":set " ++ cmdArg+  exec ghci outHdl cmd >>= \case+    Left err -> return $ Left err+    Right _  -> return $ Right ()++-- |+--+loadFile :: GHCiProcess+         -> OutputHandler+         -> FilePath+         -> IO (Either ErrorData [ModuleName])+loadFile ghci outHdl cmdArg = do+  let cmd = ":load " ++ cmdArg+  outHdl $ cmd ++ "\n"+  writeLine ghci cmd >>= \case+    Left err -> return $ Left err+    Right _ -> readLineWhileIO ghci endOfLoadFile >>= withLoadResult++  where+    endOfLoadFile acc = do+      let curStr = takeLastMsg acc+      outHdl $ curStr ++ "\n"+      if| U.startswith "Ok," curStr     -> return False+        | U.startswith "Failed," curStr -> return False+        | otherwise                     -> return True+    +    takeLastMsg [] = ""+    takeLastMsg xs = last xs++    withLoadResult (Left err ) = return $ Left err+    withLoadResult (Right msges) = readTillPrompt ghci >>= \case+      Left err -> return $ Left err+      Right msg -> do+        outHdl msg+        withLoadResultMsg (takeLastMsg msges)+    +    -- | +    -- Ok, modules loaded: Lib, Main, LibSpec. -> [Lib, Main, LibSpec]+    -- Failed, modules loaded: none.+    --+    withLoadResultMsg msg+      | U.startswith "Ok," msg =+        return $ Right+               $ U.split ", "+               $ U.replace "Ok, modules loaded: " ""+               $ init+               $ U.strip+               $ msg+      | otherwise = return $ Left $ "file load error. '" ++ cmdArg ++ "'"+      ++-- |+--+loadModule :: GHCiProcess -> OutputHandler -> [ModuleName] -> IO (Either ErrorData ())+loadModule ghci outHdl mods = do+  let cmd = ":module +" ++ U.join " " mods+  exec ghci outHdl cmd >>= \case+    Left err -> return $ Left err+    Right _  -> return $ Right ()++-- |+--+setBreak :: GHCiProcess+         -> OutputHandler+         -> ModuleName+         -> LineNo+         -> IO (Either ErrorData BreakId)+setBreak ghci outHdl modName lineNo = do+  let cmd = ":break " ++ modName ++ " " ++ show lineNo+  exec ghci outHdl cmd >>= \case+    Left err -> return $ Left err+    Right msg -> getBreakId msg++  where+    getBreakId msg = case parse getBreakIdParser "getBreakId" msg of+      Right no  -> return $ Right no +      Left  err -> return $ Left $ "unexpected break set result. " ++ show err ++ msg++    getBreakIdParser = do+      _ <- manyTill anyChar (string "Breakpoint ")+      no <- manyTill digit (string " activated at")+      return $ read no++-- |+--+setFuncBreak :: GHCiProcess+             -> OutputHandler+             -> String+             -> IO (Either ErrorData (BreakId, SourcePosition))+setFuncBreak ghci outHdl name = do+  let cmd = ":break " ++ name+  exec ghci outHdl cmd >>= \case+    Left err -> return $ Left err+    Right msg -> getBreakId msg++  where+    getBreakId msg = case parse getBreakIdParser "getBreakId" msg of+      Right no  -> return $ Right no +      Left  err -> return $ Left $ "unexpected break set result. " ++ show err ++ msg++    getBreakIdParser = do+      _   <- manyTill anyChar (string "Breakpoint ")+      no  <- manyTill digit (string " activated at ")+      pos <- parsePosition+      return (read no, pos)++-- |+--+delete :: GHCiProcess -> OutputHandler -> BreakId -> IO (Either ErrorData ())+delete ghci outHdl bid = do+  let cmd = ":delete " ++ show bid+  exec ghci outHdl cmd >>= \case+    Left err -> return $ Left err+    Right _  -> return $ Right ()++-- |+--+traceMain :: GHCiProcess -> OutputHandler -> IO (Either ErrorData SourcePosition)+traceMain ghci outHdl = do+  let cmd = ":trace main"+  exec ghci outHdl cmd >>= \case+    Left err  -> return $ Left err+    Right msg -> return $ extractSourcePosition msg++-- |+--+trace :: GHCiProcess -> OutputHandler -> IO (Either ErrorData SourcePosition)+trace ghci outHdl = do+  let cmd = ":trace"+  exec ghci outHdl cmd >>= \case+    Left err  -> return $ Left err+    Right msg -> return $ extractSourcePosition msg++-- |+--+step :: GHCiProcess -> OutputHandler -> IO (Either ErrorData SourcePosition)+step ghci outHdl = do+  let cmd = ":step"+  exec ghci outHdl cmd >>= \case+    Left err  -> return $ Left err+    Right msg -> return $ extractSourcePosition msg++-- |+--+stepLocal :: GHCiProcess -> OutputHandler -> IO (Either ErrorData SourcePosition)+stepLocal ghci outHdl = do+  let cmd = ":steplocal"+  exec ghci outHdl cmd >>= \case+    Left err  -> return $ Left err+    Right msg -> return $ extractSourcePosition msg++-- |+--+history :: GHCiProcess -> OutputHandler -> IO (Either ErrorData [StackFrame])+history ghci outHdl = do+  let cmd = ":history"+  exec ghci outHdl cmd >>= \case+    Left err  -> return $ Left err+    Right msg -> return $ extractStackFrame msg++-- |+--   引数の移動量はghc8から対応+--+back :: GHCiProcess -> OutputHandler -> Int -> IO (Either ErrorData SourcePosition)+back ghci outHdl _ = do+  -- let cmd = ":back " ++ show val+  exec ghci outHdl ":back" >>= \case+    Left err  -> return $ Left err+    Right msg -> return $ extractTracePosition msg++-- |+--   引数の移動量はghc8から対応+--+forward :: GHCiProcess -> OutputHandler -> Int -> IO (Either ErrorData SourcePosition)+forward ghci outHdl _ = do+  -- let cmd = ":forward " ++ show val+  exec ghci outHdl ":forward" >>= \case+    Left err  -> return $ Left err+    Right msg -> return $ extractTracePosition msg++-- |+--+bindings :: GHCiProcess -> OutputHandler -> IO (Either ErrorData [BindingData])+bindings ghci outHdl = do+  let cmd = ":show bindings"+  exec ghci outHdl cmd >>= \case+    Left err  -> return $ Left err+    Right msg -> return $ extractBindingBindingDatas msg+++-- |+--  intaractve error is returned as Left Error+--+force :: GHCiProcess -> OutputHandler -> String -> IO (Either ErrorData String)+force ghci outHdl target = do+  let cmd = ":force " ++ target+  exec ghci outHdl cmd >>= \case+    Left err  -> return $ Left err+    Right msg -> return $ extractErrorResult (normalizeConsoleOut msg) ++-- |+--  intaractve error is returned as Left Error+--+info :: GHCiProcess -> OutputHandler -> String -> IO (Either ErrorData String)+info ghci outHdl target = do+  let cmd = ":info " ++ target+  exec ghci outHdl cmd >>= \case+    Left err  -> return $ Left err+    Right msg -> return $ extractErrorResult (normalizeConsoleOut msg) ++-- |+--  intaractve error is returned as Left Error+--+showType :: GHCiProcess -> OutputHandler -> String -> IO (Either ErrorData String)+showType ghci outHdl target = do+  let cmd = ":type " ++ target+  exec ghci outHdl cmd >>= \case+    Left err  -> return $ Left err+    Right msg -> return $ extractErrorResult (normalizeConsoleOut msg) ++-- |+--  intaractve error is returned as Left Error+--+showKind :: GHCiProcess -> OutputHandler -> String -> IO (Either ErrorData String)+showKind ghci outHdl target = do+  let cmd = ":kind " ++ target+  exec ghci outHdl cmd >>= \case+    Left err  -> return $ Left err+    Right msg -> return $ extractErrorResult (normalizeConsoleOut msg) ++-- |+--+execBool :: GHCiProcess -> OutputHandler -> String -> IO (Either ErrorData Bool)+execBool ghci outHdl cmd = exec ghci outHdl cmd >>= \case+  Left err  -> return $ Left err+  Right msg -> return $ getConditionResult msg++  where+    getConditionResult :: String -> Either ErrorData Bool+    getConditionResult res+      | U.startswith "True"  res = Right True+      | U.startswith "False" res = Right False+      | otherwise = Left $ "invalid condition result. " ++ res+      ++-- |+--   Private Utility+--++-- |+--  run command and return result string.+--+exec :: GHCiProcess -> OutputHandler -> String -> IO (Either ErrorData String)+exec ghci outHdl cmd = do+  outHdl $ cmd ++ "\n"++  writeLine ghci cmd >>= \case+    Left err -> return $ Left err+    Right _ -> readTillPrompt ghci >>= \case+      Left err -> return $ Left err+      Right msg -> do+        outHdl msg+        return $ Right msg++-- |+--+extractSourcePosition :: String -> (Either ErrorData SourcePosition)+extractSourcePosition src = case parse sourcePositionParser "extractSourcePosition" src of+  Right pos -> Right pos+  Left err  -> Left $ show err ++ " [INPUT]" ++ src++  where+    sourcePositionParser = try parse7 <|> try parse8++    parse7 = do+      _ <- manyTill anyChar (try (string "Stopped at "))+      parsePosition++    parse8 = do+      _ <- manyTill anyChar (try (string "Stopped in "))+      _ <- manyTill anyChar (try (string ", "))+      parsePosition++-- |+--  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:+--+parsePosition :: forall u. ParsecT String u Identity SourcePosition+parsePosition = do+  path <- manyTill anyChar (string (_HS_FILE_EXT ++ ":"))+  (sl, sn, el, en) <- try parseA <|> try parseB <|> try parseC+  return $ SourcePosition (drive2lower path ++ _HS_FILE_EXT) sl sn el en+  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))++    -- |+    --  to lowercase Windows drive letter +    drive2lower :: FilePath -> FilePath+    drive2lower (x : ':' : xs) = toLower x : ':' : xs+    drive2lower xs = xs++-- |+--  トレース情報のパーサ+--+--  parser of+--    Phoityne>>= :history+--      -6  : spec (D:\haskell\unit-testing\test\LibSpec.hs:20:9-25)+--      -7  : spec (D:\haskell\unit-testing\test\LibSpec.hs:(34,7)-(35,26))+--+--+extractStackFrame :: String -> (Either ErrorData [StackFrame])+extractStackFrame src = go [] $ reverse $ filter (U.startswith "-") $ lines src+  where+    go acc [] = Right acc+    go acc (x:xs) = case parse stackFrameParser "extractStackFrame" (init x) of+      Left err  -> Left $ show err ++ " " ++ x+      Right dat -> go (dat:acc) xs++    stackFrameParser = do+      char '-'+      traceId  <- manyTill digit (many1 space >> char ':' >> space)+      funcName <- manyTill anyChar (space >> char '(')+      pos      <- parsePosition++      return $ StackFrame (read traceId) (removeColorCode funcName) pos++    removeColorCode str = case parse removeColorCodeParser "removeColorCode" str of+      Right res -> res+      Left _    -> str++    removeColorCodeParser = do+      let _esc_code = chr 27+      char _esc_code >> char '[' >> anyChar >> char 'm' +      funcName <- manyTill anyChar (char _esc_code)+      return funcName++-- |+--  トレース位置のパーサ+--+--  parser of+--    Phoityne>>= :back 10+--    Logged breakpoint at D:\haskell\unit-testing8\test\LibSpec.hs:(30,7)-(31,25)+--    Stopped at D:\haskell\unit-testing8\test\LibSpec.hs:31:9-25+--+extractTracePosition :: String -> (Either ErrorData SourcePosition)+extractTracePosition src = case parse extractTracePositionParser "extractTracePosition" src of+  Right pos -> Right pos+  Left err  -> Left $ show err ++ " [INPUT]" ++ src++  where+    extractTracePositionParser = try stopPos <|> try loggedPos++    stopPos = do+      _ <- manyTill anyChar (try (string "Stopped at "))+      parsePosition++    loggedPos = do+      _ <- manyTill anyChar (try (string "Logged breakpoint at "))+      parsePosition++-- |+--  バインディング変数のパーサ+--+--  parser of+--    Phoityne>>= :show bindings+--    _result ::+--       hspec-expectations-0.7.2:Test.Hspec.Expectations.Expectation = _+--    it :: [String] = []+--    Phoityne>>=+--+extractBindingBindingDatas :: String -> (Either ErrorData [BindingData]) +extractBindingBindingDatas src = case parse bindingBindingDatasParser "extractBindingBindingDatas" (normalizeConsoleOut src) of+  Right vals -> Right vals+  Left err   -> Left $ show err ++ " [INPUT]" ++ src++  where+    bindingBindingDatasParser = manyTill bindingBindingDataParser eof++    bindingBindingDataParser = do+      varName <- manyTill anyChar (string " :: ")+      typeName <- manyTill anyChar (try (string " = "))+      valStr  <- try (manyTill anyChar space) <|> try (manyTill anyChar eof)+      return $ BindingData (U.strip varName) (U.strip typeName) (U.strip valStr)+++-- |+--+normalizeConsoleOut :: String -> String+normalizeConsoleOut = U.join " " . filter (not . U.startswith "***") . map U.strip . init . lines+++-- |+--  interactive errorのパーサ+--    Phoityne>>= :info IO xx+--+--      <interactive>:1:1: error: Not in scope: ‘xx’+--    Phoityne>>=+--+extractErrorResult :: String -> (Either ErrorData String) +extractErrorResult str = case parse errorResultParser "extractErrorResult" str of+  Right errMsg -> Left errMsg+  Left  _      -> Right $ str+  where+    errorResultParser = do+      _ <- manyTill anyChar (string "<interactive>")+      _ <- manyTill anyChar (char ' ')+      manyTill anyChar eof
+ app/Phoityne/GHCi/IO/Process.hs view
@@ -0,0 +1,209 @@+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE MultiWayIf          #-}+{-# LANGUAGE BinaryLiterals      #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable  #-}++module Phoityne.GHCi.IO.Process (+    ErrorData+  , GHCiProcess (..)+  , runProcess+  , exitProcess+  , writeLine+  , readTillPrompt+  , readTillEOF+  , readCharWhile+  , readCharWhileIO+  , readLineWhile+  , readLineWhileIO+  ) where++import GHC.IO.Encoding+import Distribution.System+import qualified System.Process as S+import qualified System.IO as S+import qualified System.Exit as S+import qualified Control.Exception as E+import qualified Data.String.Utils as U++-- |+--  command error message.+--+type ErrorData = String++-- |+--   GHCi process data.+--+data GHCiProcess = GHCiProcess+  {+    inGHCiProcess     :: S.Handle+  , outGHCiProcess    :: S.Handle+  , errGHCiProcess    :: S.Handle+  , procGHCiProcess   :: S.ProcessHandle+  , promptGHCiProcess :: String+  }++-- |+--  run ghci.+--+runProcess :: String+           -> [String]+           -> FilePath+           -> String+           -> IO (Either ErrorData GHCiProcess)+runProcess cmd opts cwd pmt = flip E.catches handlers $ do++  (fromPhoityneHandle, toGHCiHandle) <- S.createPipe+  (fromGHCiHandle, toPhoityneHandle) <- S.createPipe++  osEnc <- getReadHandleEncoding++  S.hSetBuffering toPhoityneHandle S.NoBuffering+  S.hSetEncoding toPhoityneHandle osEnc+  S.hSetNewlineMode toPhoityneHandle $ S.NewlineMode S.CRLF S.LF++  S.hSetBuffering fromPhoityneHandle S.NoBuffering+  S.hSetEncoding fromPhoityneHandle  S.utf8+  S.hSetNewlineMode fromPhoityneHandle $ S.NewlineMode S.LF S.LF++  S.hSetBuffering toGHCiHandle S.NoBuffering+  S.hSetEncoding toGHCiHandle S.utf8+  S.hSetNewlineMode toGHCiHandle $ S.NewlineMode S.LF S.LF++  S.hSetBuffering fromGHCiHandle S.NoBuffering+  S.hSetEncoding fromGHCiHandle osEnc+  S.hSetNewlineMode fromGHCiHandle $ S.NewlineMode S.CRLF S.LF++  ghciProc <- S.runProcess cmd opts (Just cwd) Nothing (Just fromPhoityneHandle) (Just toPhoityneHandle) (Just toPhoityneHandle)++  return . Right $ GHCiProcess toGHCiHandle fromGHCiHandle fromGHCiHandle ghciProc pmt++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = return . Left . show $ e++    -- |+    --  +    -- +    getReadHandleEncoding :: IO TextEncoding+    getReadHandleEncoding = if+      | Windows == buildOS -> mkTextEncoding "CP932//TRANSLIT"+      | otherwise -> mkTextEncoding "UTF-8//TRANSLIT"+++-- |+--   exit ghci.+--+exitProcess :: GHCiProcess -> IO (Either ErrorData S.ExitCode)+exitProcess (GHCiProcess _ _ _ proc _) = flip E.catches handlers $ do+  code <- S.waitForProcess proc+  return . Right $ code+  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = return . Left . show $ e++-- |+--  write to ghci.+--+writeLine :: GHCiProcess -> String -> IO (Either ErrorData ())+writeLine (GHCiProcess ghciIn _ _ _ _) writeData = flip E.catches handlers $ S.hIsOpen ghciIn >>= \case+  True  -> do+    S.hPutStrLn ghciIn writeData+    return $ Right ()+  False -> return $ Left "handle not open."+  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = return . Left . show $ e++-- |+--   read char till prompt.+--+readTillPrompt :: GHCiProcess -> IO (Either ErrorData String)+readTillPrompt proc@(GHCiProcess _ _ _ _ pmt) = readCharWhile proc (not . U.endswith pmt)++-- |+--   read char till EOF.+--+readTillEOF :: GHCiProcess -> IO (Either ErrorData String)+readTillEOF proc = readCharWhile proc (const True)+++-- |+--   read char from ghci.+--+readCharWhile :: GHCiProcess -> (String -> Bool) -> IO (Either ErrorData String)+readCharWhile (GHCiProcess _ ghciOut _ _ _) condProc = flip E.catches handlers $ S.hIsOpen ghciOut >>= \case+  True  -> go []+  False -> return . Left $ "handle not open."+  where+    go acc = S.hIsEOF ghciOut >>= \case+      True  -> return . Right $ acc+      False -> do+        c <- S.hGetChar ghciOut+        let acc' = acc ++ [c]+        if condProc acc' then go acc'+          else return . Right $ acc'++    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = return . Left . show $ e++-- |+--   read char from ghci.+--+readCharWhileIO :: GHCiProcess -> (String -> IO Bool) -> IO (Either ErrorData String)+readCharWhileIO (GHCiProcess _ ghciOut _ _ _) condProc = flip E.catches handlers $ S.hIsOpen ghciOut >>= \case+  True  -> go []+  False -> return . Left $ "handle not open."+  where+    go acc = S.hIsEOF ghciOut >>= \case+      True  -> return . Right $ acc+      False -> do+        c <- S.hGetChar ghciOut+        let acc' = acc ++ [c]+        condProc acc' >>= \case +          True  -> go acc'+          False -> return . Right $ acc'++    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = return . Left . show $ e++-- |+--  read line from ghci.+--+readLineWhile :: GHCiProcess -> ([String] -> Bool) -> IO (Either ErrorData [String])+readLineWhile (GHCiProcess _ ghciOut _ _ _) condProc = flip E.catches handlers $ S.hIsOpen ghciOut >>= \case+  True  -> go []+  False -> return . Left $ "handle not open."+  where+    go acc = S.hIsEOF ghciOut >>= \case+      True -> return . Right $ acc+      False -> do+        l <- S.hGetLine ghciOut+        let acc' = acc ++ [l]+        if condProc acc' then go acc'+          else return . Right $ acc'++    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = return . Left . show $ e+++-- |+--  read line from ghci.+--+readLineWhileIO :: GHCiProcess -> ([String] -> IO Bool) -> IO (Either ErrorData [String])+readLineWhileIO (GHCiProcess _ ghciOut _ _ _) condProc = flip E.catches handlers $ S.hIsOpen ghciOut >>= \case+  True  -> go []+  False -> return . Left $ "handle not open."+  where+    go acc = S.hIsEOF ghciOut >>= \case+      True -> return . Right $ acc+      False -> do+        l <- S.hGetLine ghciOut+        let acc' = acc ++ [l]+        condProc acc' >>= \case+          True  -> go acc'+          False -> return . Right $ acc'++    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = return . Left . show $ e
− app/Phoityne/IO/CUI/GHCiControl.hs 
@@ -1,149 +0,0 @@-{-# 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 
@@ -1,209 +0,0 @@-{-# 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.Exit-import Control.Concurrent-import Data.String.Utils-import qualified Data.ConfigFile as C----- |----data SysEnv =-  SysEnv {-    promptSysEnv :: String-  } deriving (Show, Read, Eq, Ord)----- |---  ロジックメイン--- -run :: A.ArgData      -- コマンドライン引数-    -> C.ConfigParser -- INI設定-    -> IO Int         -- exit code-run _ _ = do---  mvarENV <- newMVar $ SysEnv _PHOITYNE_GHCI_PROMPT--  mvarCUI <- newMVar GHCI.defaultExternalCommandData---  let cmdData = createCmdData mvarENV mvarCUI--  GUI.run cmdData--  return 1--  where-    createCmdData mvarENV mvarCUI =-      GUI.DebugCommandData {-        GUI.startDebugCommandData        = debugStart mvarCUI-      , GUI.stopDebugCommandData         = stopDebug mvarCUI-      , GUI.readDebugCommandData         = readResult mvarENV mvarCUI-      , GUI.readLinesDebugCommandData    = readLines mvarCUI-      , GUI.promptDebugCommandData       = setPrompt mvarENV mvarCUI-      , 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-      , GUI.typeDebugCommandData         = \arg -> execCmd mvarCUI $ ":type " ++ arg-      , GUI.moduleDebugCommandData       = \arg -> execCmd mvarCUI $ ":module " ++ arg-      , GUI.envSetPromptDebugCommandData = envSetPrompt mvarENV-      , GUI.envGetPromptDebugCommandData = envGetPrompt mvarENV-      }---- |------ -envSetPrompt :: MVar SysEnv -> String -> IO ()-envSetPrompt mvarENV prmt = do-  sysEnv <- takeMVar mvarENV-  putMVar mvarENV sysEnv{promptSysEnv = prmt}---- |------ -envGetPrompt :: MVar SysEnv -> IO String-envGetPrompt mvarENV = readMVar mvarENV >>= return . promptSysEnv----- |-------setPrompt :: MVar SysEnv -> MVar GHCI.ExternalCommandData -> IO String-setPrompt mvarENV mvarCUI = do-  prmpt <- envGetPrompt mvarENV-  execCmd mvarCUI $ ":set prompt \"" ++ prmpt ++ "\""----- |------ -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 -> String -> [String] -> FilePath -> IO ()-debugStart mvarCUI cmd opts cwd = do-  exeData <- GHCI.run cmd opts $ 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 SysEnv -> MVar GHCI.ExternalCommandData -> IO String-readResult mvarENV mvarCUI = do-  prmpt <- envGetPrompt mvarENV-  readWhile mvarCUI $ not . endswith prmpt----- |------ -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 
@@ -1,1839 +0,0 @@-{-# 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 Phoityne.IO.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.TerminatedEventBodyJSON 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.Directory-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-import qualified System.FSNotify as FSN-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-import Safe---- |-------data DebugContext = -  DebugContext {-    resSeqDebugContext          :: Int-  , breakPointDatasDebugContext :: BreakPointDatas-  , workspaceDebugContext       :: FilePath-  , startupDebugContext         :: FilePath-  , debugStartedDebugContext    :: Bool-  , debugStoppedPosDebugContext :: Maybe HighlightTextRangeData-  , currentFrameIdDebugContext  :: Int-  , modifiedDebugContext        :: Bool-  } deriving (Show, Read, Eq, Ord)------ |-------data DebugCommandData =-  DebugCommandData {-    startDebugCommandData        :: String -> [String] -> 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-  , typeDebugCommandData         :: String -> IO String-  , moduleDebugCommandData       :: String -> IO String-  , envSetPromptDebugCommandData :: String -> IO ()-  , envGetPromptDebugCommandData :: 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 = '/'---- |-------_TASKS_JSON_FILE_CONTENTS :: BSL.ByteString-_TASKS_JSON_FILE_CONTENTS = str2lbs $ Data.String.Utils.join "\n" $-  [-    "{"-  , "  // atuomatically created by phoityne-vscode"-  , "  "-  , "  \"version\": \"0.1.0\","-  , "  \"isShellCommand\": true,"-  , "  \"showOutput\": \"always\","-  , "  \"suppressTaskName\": true,"-  , "  \"windows\": {"-  , "    \"command\": \"cmd\","-  , "    \"args\": [\"/c\"]"-  , "  },"-  , "  \"linux\": {"-  , "    \"command\": \"sh\","-  , "    \"args\": [\"-c\"]"-  , "  },"-  , "  \"osx\": {"-  , "    \"command\": \"sh\","-  , "    \"args\": [\"-c\"]"-  , "  },"-  , "  \"tasks\": ["-  , "    {"-  , "       \"taskName\": \"stack build\","-  , "       \"args\": [ \"echo START_STACK_BUILD && cd ${workspaceRoot} && stack build && echo END_STACK_BUILD \" ]"-  , "    },"-  , "    { "-  , "       \"isBuildCommand\": true,"-  , "       \"taskName\": \"stack clean & build\","-  , "       \"args\": [ \"echo START_STACK_CLEAN_AND_BUILD && cd ${workspaceRoot} && stack clean && stack build && echo END_STACK_CLEAN_AND_BUILD \" ]"-  , "    },"-  , "    { "-  , "       \"isTestCommand\": true,"-  , "       \"taskName\": \"stack test\","-  , "       \"args\": [ \"echo START_STACK_TEST && cd ${workspaceRoot} && stack test && echo END_STACK_TEST \" ]"-  , "    },"-  , "    { "-  , "       \"isWatching\": true,"-  , "       \"taskName\": \"stack watch\","-  , "       \"args\": [ \"echo START_STACK_WATCH && cd ${workspaceRoot} && stack build --test --no-run-tests --file-watch && echo END_STACK_WATCH \" ]"-  , "    }"-  , "  ]"-  , "}"-  ]------ |-------_ERR_MSG_URL :: [String]-_ERR_MSG_URL = [ "`stack update` and install new phoityen-vscode."-               , "Or check information on https://marketplace.visualstudio.com/items?itemName=phoityne.phoityne-vscode"-               ]------ |-------defaultDebugContext :: DebugContext-defaultDebugContext = DebugContext _INITIAL_RESPONSE_SEQUENCE (MAP.fromList []) "" "" False Nothing 0 False----- |-------getKeyOfHighlightTextRangeData :: HighlightTextRangeData -> BreakPointDataKey-getKeyOfHighlightTextRangeData (HighlightTextRangeData file line _ _ _) = (file, line)----- |-------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 mvarCtx = 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-          cnt <- BSL.hGet stdin len-          handleRequest cmdData mvarCtx newBuf 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 -> BSL.ByteString -> IO ()-handleRequest cmdData mvarCtx contLenStr jsonStr = do-  case J.eitherDecode jsonStr :: Either String J.Request of-    Left  err -> do-      -- req_secが不明のため、エラー出力のみ行う。-      -- ただし、initializeが完了していない場合は、エラー出力イベントが受理されない。-      -- launchしていな場合はログ出力ができない。-      -- 無視して、次のリクエストを待つ。-      let msg =  L.intercalate " " [ "request request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]-              ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL)-              ++ "\n"--      putStrLnStderr mvarCtx msg--      resSeq <- incResSeq mvarCtx-      let terminatedEvt    = J.defaultTerminatedEvent resSeq-          terminatedEvtStr = J.encode terminatedEvt-      sendEventL terminatedEvtStr--    Right (J.Request cmd) -> handle contLenStr jsonStr cmd-    -  wait cmdData mvarCtx--  where--    handle contLenStr jsonStr "initialize" = case J.eitherDecode jsonStr :: Either String J.InitializeRequest of-      Right req -> initializeHandler mvarCtx req-      Left  err -> do-        -- initializeが完了していない場合は、エラー出力イベントが受理されない。-        -- responceをエラーで返す。メッセージは1行で作成する必要がある。-        -- launchしていな場合はログ出力ができない。-        -- res_seqは1固定とする。-        let msg = L.intercalate " " $ ["initialize request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err] ++ _ERR_MSG_URL-        resSeq <- incResSeq mvarCtx-        sendResponse $ J.encode $ J.parseErrorInitializeResponse resSeq msg---    handle contLenStr jsonStr "launch" = case J.eitherDecode jsonStr :: Either String J.LaunchRequest of-      Right req -> launchHandler cmdData mvarCtx req-      Left  err -> do-        -- launchしていな場合はログ出力ができない。-        -- req_secが不明のため、エラー出力のみ行う。-        let msg = L.intercalate " " ["launch request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]-                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"-        putStrLnStderr mvarCtx msg--        resSeq <- incResSeq mvarCtx-        let terminatedEvt    = J.defaultTerminatedEvent resSeq-            terminatedEvtStr = J.encode terminatedEvt-        sendEventL terminatedEvtStr---    handle contLenStr jsonStr "disconnect" = case J.eitherDecode jsonStr :: Either String J.DisconnectRequest of-      Right req -> disconnectHandler cmdData mvarCtx req-      Left  err -> do-        let msg = L.intercalate " " ["disconnect request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]-                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"-        putStrLnStderr mvarCtx msg---    handle contLenStr jsonStr "setBreakpoints" = case J.eitherDecode jsonStr :: Either String J.SetBreakpointsRequest of-      Right req -> setBreakpointsHandler cmdData mvarCtx req-      Left  err -> do-        let msg = L.intercalate " " ["setBreakpoints request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]-                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"-        putStrLnStderr mvarCtx msg---    handle contLenStr jsonStr "continue" = case J.eitherDecode jsonStr :: Either String J.ContinueRequest of-      Right req -> continueHandler cmdData mvarCtx req-      Left  err -> do-        let msg = L.intercalate " " ["continue request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]-                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"-        putStrLnStderr mvarCtx msg---    handle contLenStr jsonStr "next" = case J.eitherDecode jsonStr :: Either String J.NextRequest of-      Right req -> stepOverHandler cmdData mvarCtx req-      Left  err -> do-        let msg = L.intercalate " " ["next request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]-                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"-        putStrLnStderr mvarCtx msg---    handle contLenStr jsonStr "stepIn" = case J.eitherDecode jsonStr :: Either String J.StepInRequest of-      Right req -> stepInHandler cmdData mvarCtx req-      Left  err -> do-        let msg = L.intercalate " " ["stepIn request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]-                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"-        putStrLnStderr mvarCtx msg---    handle contLenStr jsonStr "stepOut" = case J.eitherDecode jsonStr :: Either String J.StepOutRequest of-      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."--      Left  err -> do-        let msg = L.intercalate " " ["stepOut request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]-                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"-        putStrLnStderr mvarCtx msg---    handle contLenStr jsonStr "pause" = case J.eitherDecode jsonStr :: Either String J.PauseRequest of-      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."--      Left  err -> do-        let msg = L.intercalate " " ["pause request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]-                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"-        putStrLnStderr mvarCtx msg---    handle contLenStr jsonStr "stackTrace" = case J.eitherDecode jsonStr :: Either String J.StackTraceRequest of-      Right req -> stackTraceHandler cmdData mvarCtx req-      Left  err -> do-        let msg = L.intercalate " " ["stackTrace request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]-                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"-        putStrLnStderr mvarCtx msg---    handle contLenStr jsonStr "scopes" = case J.eitherDecode jsonStr :: Either String J.ScopesRequest of-      Right req -> scopesHandler cmdData mvarCtx req-      Left  err -> do-        let msg = L.intercalate " " ["scopes request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]-                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"-        putStrLnStderr mvarCtx msg---    handle contLenStr jsonStr "variables" = case J.eitherDecode jsonStr :: Either String J.VariablesRequest of-      Right req -> variablesHandler cmdData mvarCtx req-      Left  err -> do-        let msg = L.intercalate " " ["variables request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]-                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"-        putStrLnStderr mvarCtx msg---    handle contLenStr jsonStr "source" = case J.eitherDecode jsonStr :: Either String J.SourceRequest of-      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."--      Left  err -> do-        let msg = L.intercalate " " ["source request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]-                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"-        putStrLnStderr mvarCtx msg---    handle contLenStr jsonStr "threads" = case J.eitherDecode jsonStr :: Either String J.ThreadsRequest of-      Right req -> threadsHandler cmdData mvarCtx req-      Left  err -> do-        let msg = L.intercalate " " ["threads request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]-                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"-        putStrLnStderr mvarCtx msg---    handle contLenStr jsonStr "evaluate" = case J.eitherDecode jsonStr :: Either String J.EvaluateRequest of-      Right req -> evaluateHandler cmdData mvarCtx req-      Left  err -> do-        let msg = L.intercalate " " ["evaluate request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]-                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"-        putStrLnStderr mvarCtx msg---    handle contLenStr jsonStr cmd = do-      let msg = L.intercalate " " ["unknown request command.", cmd, lbs2str contLenStr, lbs2str jsonStr]-      putStrLnStderr mvarCtx msg----- |----sendEvent :: BSL.ByteString -> IO ()-sendEvent str = sendResponseInternal str---- |----sendEventL :: BSL.ByteString -> IO ()-sendEventL str = do-  infoM _LOG_NAME $ "[EVENT]" ++ lbs2str str-  sendEvent str----- |----sendResponseL :: BSL.ByteString -> IO ()-sendResponseL str = do-  infoM _LOG_NAME $ "[RESPONSE]" ++ lbs2str str-  sendResponse str----- |----sendResponse :: BSL.ByteString -> IO ()-sendResponse 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 req@(J.InitializeRequest seq _ _ _) = flip E.catches handlers $ do-  resSeq <- incResSeq mvarCtx-  let capa = J.InitializeResponseCapabilites False False True True [] False 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 = L.intercalate " " ["initialize request error.", show req, show e]-      resSeq <- incResSeq mvarCtx-      sendResponse $ J.encode $ J.errorInitializeResponse resSeq req msg -      putStrLnStderr mvarCtx 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-      logFile     = J.logFileLaunchRequestArguments args-      logLevelStr = J.logLevelLaunchRequestArguments args-      prmptStr    = J.ghciPromptLaunchRequestArguments args-      cmdStr      = J.ghciCmdLaunchRequestArguments args--  -- コンテキストデータの保持-  ctx <- takeMVar mvarCtx-  putMVar mvarCtx ctx {-      workspaceDebugContext = ws-    , startupDebugContext   = su-    }--  envSetPromptDebugCommandData cmdData $ prmptStr--  -- ロギング設定-  logLevel <- case readMay logLevelStr of-    Just lv -> return lv-    Nothing -> do-      putStrLnStderr mvarCtx $ "log priority is invalid. WARNING set. [" ++ logLevelStr ++ "]"-      return WARNING--  setupLogger logFile logLevel--  logRequest $ show req--  -- tasks.jsonファイルの準備-  prepareTasksJsonFile mvarCtx ws---  -- ghciのランチ-  runGHCi cmdData mvarCtx cmdStr ws >>= ghciLaunched --    -  where-    handlers = [ E.Handler someExcept ]-    someExcept (e :: E.SomeException) = do-      let msg = L.intercalate " " ["launch request error.", show req, show e]-      resSeq <- incResSeq mvarCtx-      sendResponse $ J.encode $ J.errorLaunchResponse resSeq req msg -      putStrLnStderr mvarCtx msg---    -- |-    -- -    prepareTasksJsonFile :: MVar DebugContext -> FilePath -> IO ()-    prepareTasksJsonFile mvarCtx ws = do-      let jsonFile = ws </> ".vscode" </> "tasks.json"-    -      doesFileExist jsonFile >>= \case-        True  -> infoM _LOG_NAME $ "tasks.json file exists. " ++ jsonFile -        False -> do-          putStrLnConsole mvarCtx $ "create tasks.json file. " ++ jsonFile-          saveFileLBS jsonFile _TASKS_JSON_FILE_CONTENTS--    -- |-    -- -    ghciLaunched False = do-      let msg = L.intercalate " " ["ghci launch error."]-      resSeq <- incResSeq mvarCtx-      sendResponse $ J.encode $ J.errorLaunchResponse resSeq req msg -      putStrLnStderr mvarCtx msg--    ghciLaunched True = do-      startupRes <- loadHsFile cmdData mvarCtx (J.startupLaunchRequestArguments args)--      when (False == startupRes) $ do-        let msg = L.intercalate " " ["startup load error.", J.startupLaunchRequestArguments args]-        putStrLnStderr mvarCtx msg--      -- レスポンスとinitializedイベント送信-      resSeq <- incResSeq mvarCtx-      sendResponseL $ J.encode $ J.defaultLaunchResponse resSeq req-    -      resSeq <- incResSeq mvarCtx-      sendEventL $ J.encode $ J.defaultInitializedEvent resSeq-    -      -- ファイル変更ウォッチの開始-      watch cmdData mvarCtx-    -      putStrLnConsole mvarCtx $ L.intercalate "\n" infoMsg-      putStrStdout mvarCtx $ J.ghciPromptLaunchRequestArguments args-    -    -- ランチ完了後のメッセージ出力-    infoMsg = [-              ""-            , "  Now, ghci initialized."-            , "  Press F5 to start debugging."-            , "  Or modify source code. it will be loaded to ghci automatically."-            , ""-            ]---- |----disconnectHandler :: DebugCommandData -> MVar DebugContext -> J.DisconnectRequest -> IO ()-disconnectHandler cmdData mvarCtx req = flip E.catches handlers $ do--  logRequest $ show req--  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-  sendResponseL $ J.encode $ J.defaultDisconnectResponse resSeq req--  where-    handlers = [ E.Handler someExcept ]-    someExcept (e :: E.SomeException) = do-      let msg = L.intercalate " " ["disconnect request error.", show req, show e]-      resSeq <- incResSeq mvarCtx-      sendResponseL $ J.encode $ J.errorDisconnectResponse resSeq req msg -      putStrLnStderr mvarCtx msg----- |----setBreakpointsHandler :: DebugCommandData -> MVar DebugContext -> J.SetBreakpointsRequest -> IO ()-setBreakpointsHandler cmdData mvarCtx req = flip E.catches handlers $ do-  logRequest $ show req--  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}-  sendResponseL resStr--  resSeq <- incResSeq mvarCtx-  let stopEvt    = J.defaultStoppedEvent resSeq-      stopEvtStr = J.encode stopEvt-  sendEventL stopEvtStr---  where-    handlers = [ E.Handler someExcept ]-    someExcept (e :: E.SomeException) = do-      let msg = L.intercalate " " ["setBreakpoints request error.", show req, show e]-      resSeq <- incResSeq mvarCtx-      sendResponseL $ J.encode $ J.errorSetBreakpointsResponse resSeq req msg -      putStrLnStderr mvarCtx 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 -> do-          --putStrLnStdout mvarCtx $ "set breakpoint on " ++ filePathBreakPointData reqBp ++ ":L" ++ show (lineNoBreakPointData reqBp) -          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-  logRequest $ show req--  resSeq <- incResSeq mvarCtx-  let resStr = J.encode $ J.defaultThreadsResponse resSeq req-  sendResponseL resStr--  where-    handlers = [ E.Handler someExcept ]-    someExcept (e :: E.SomeException) = do-      let msg = L.intercalate " " ["threads request error.", show req, show e]-      resSeq <- incResSeq mvarCtx-      sendResponseL $ J.encode $ J.errorThreadsResponse resSeq req msg -      putStrLnStderr mvarCtx msg---- |-------scopesHandler :: DebugCommandData -> MVar DebugContext -> J.ScopesRequest -> IO ()-scopesHandler cmdData mvarCtx req = flip E.catches handlers $ do-  logRequest $ show req--  let args    = J.argumentsScopesRequest req-      traceId = J.frameIdScopesArguments args--  moveFrame cmdData mvarCtx traceId--  resSeq <- incResSeq mvarCtx-  let resStr = J.encode $ J.defaultScopesResponse resSeq req-  sendResponseL resStr--  where-    handlers = [ E.Handler someExcept ]-    someExcept (e :: E.SomeException) = do-      let msg = L.intercalate " " ["scopes request error.", show req, show e]-      resSeq <- incResSeq mvarCtx-      sendResponseL $ J.encode $ J.errorScopesResponse resSeq req msg -      putStrLnStderr mvarCtx msg----- |-------variablesHandler :: DebugCommandData -> MVar DebugContext -> J.VariablesRequest -> IO ()-variablesHandler cmdData mvarCtx req = flip E.catches handlers $ do-  logRequest $ show req--  vals <- currentBindings--  resSeq <- incResSeq mvarCtx-  let res = J.defaultVariablesResponse resSeq req-      resStr = J.encode $ res{J.bodyVariablesResponse = J.VariablesBody vals}-  sendResponseL resStr--  where-    handlers = [ E.Handler someExcept ]-    someExcept (e :: E.SomeException) = do-      let msg = L.intercalate " " ["variables request error.", show req, show e]-      resSeq <- incResSeq mvarCtx-      sendResponseL $ J.encode $ J.errorVariablesResponse resSeq req msg -      putStrLnStderr mvarCtx msg--    currentBindings = do-      let bindings = bindingsDebugCommandData cmdData-          getResult = readDebugCommandData cmdData--      prmpt <- envGetPromptDebugCommandData cmdData--      cmdStr <- bindings-      infoM _LOG_NAME cmdStr--      bindStr <- getResult-      infoM _LOG_NAME bindStr--      case getBindingDataList prmpt bindStr of-        Left err   -> do -          errorM _LOG_NAME $ show err-          putStrLnStderr mvarCtx $ show err-          return []--        Right dats -> return $ map convBind2Vals dats-    -    convBind2Vals (BindingData varName modName val) = J.Variable varName modName val 0----- |-------stackTraceHandler :: DebugCommandData -> MVar DebugContext -> J.StackTraceRequest -> IO ()-stackTraceHandler cmdData mvarCtx req = flip E.catches handlers $ do-  logRequest $ show req--  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}-      sendResponseL 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}-      sendResponseL resStr--  where-    handlers = [ E.Handler someExcept ]-    someExcept (e :: E.SomeException) = do-      let msg = L.intercalate " " ["stackTrace request error.", show req, show e]-      resSeq <- incResSeq mvarCtx-      sendResponseL $ J.encode $ J.errorStackTraceResponse resSeq req msg -      putStrLnStderr mvarCtx msg---    createStackFrames (HighlightTextRangeData file sl sc el ec) = do-      ctx <- readMVar mvarCtx-      let cwd = workspaceDebugContext ctx-          csf = J.StackFrame 0 "[BP]" (J.Source (Just (src2mod cwd file)) file Nothing Nothing) sl sc el ec--      let getResult = readDebugCommandData cmdData-          history   = traceHistDebugCommandData cmdData-    -      cmdStr <- history-      infoM _LOG_NAME cmdStr--      traceStr <- getResult-      infoM _LOG_NAME 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 funcName filePath) = case parse parseHighlightTextRange "getActivatePosFromLine" filePath of-      Left err -> do-        errorM _LOG_NAME $ show err-        putStrLnStderr mvarCtx $ show err-        return xs-      Right (HighlightTextRangeData file sl sc el ec) -> return $ -        J.StackFrame (read traceId) funcName (J.Source (Just (src2mod cwd file)) file Nothing Nothing) sl sc el ec : xs---- |-------evaluateHandler :: DebugCommandData -> MVar DebugContext -> J.EvaluateRequest -> IO ()-evaluateHandler cmdData mvarCtx req = flip E.catches handlers $ do-  logRequest $ show req--  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 = L.intercalate " " ["evaluate request error.", show req, show e]-      resSeq <- incResSeq mvarCtx-      sendResponseL $ J.encode $ J.errorEvaluateResponse resSeq req msg -      putStrLnStderr mvarCtx msg---    eval "watch" exp = do-      let forceVar = forceDebugCommandData cmdData-          getResult = readDebugCommandData cmdData--      cmdStr <- forceVar exp-      infoM _LOG_NAME cmdStr-    -      cmdStr <- getResult-      infoM _LOG_NAME cmdStr--      let result = normalizeResult cmdStr--      resSeq <- incResSeq mvarCtx-      let body   = J.EvaluateBody result 0-          res    = J.defaultEvaluateResponse resSeq req-          resStr = J.encode res{J.bodyEvaluateResponse = body}-      sendResponseL resStr---    eval "hover" exp = do-      let info      = infoDebugCommandData cmdData-          getResult = readDebugCommandData cmdData--      cmdStr <- info exp-      putStrLnStdout mvarCtx cmdStr-      infoM _LOG_NAME cmdStr--      cmdStr <- getResult-      putStrStdout mvarCtx cmdStr-      infoM _LOG_NAME cmdStr--      let result = normalizeResult cmdStr--      resSeq <- incResSeq mvarCtx-      let body   = J.EvaluateBody result 0-          res    = J.defaultEvaluateResponse resSeq req-          resStr = J.encode res{J.bodyEvaluateResponse = body}-      sendResponseL resStr---    eval _ exp = do-      let exec = execCommandData cmdData-          getResult = readDebugCommandData cmdData--      prmpt <- envGetPromptDebugCommandData cmdData--      cmdStr <- exec exp-      infoM _LOG_NAME cmdStr-    -      cmdStr <- getResult-      infoM _LOG_NAME cmdStr--      -- promptを消す-      let result = unlines . init . lines $ cmdStr--      resSeq <- incResSeq mvarCtx-      let body   = J.EvaluateBody result 0-          res    = J.defaultEvaluateResponse resSeq req-          resStr = J.encode res{J.bodyEvaluateResponse = body}-      sendResponseL resStr-    -      putStrStdout mvarCtx $ "\n" ++ prmpt--    normalizeResult = L.intercalate " " . filter (not . startswith "***"). filter (not . null) . map (replace "\t" "") . map strip . init . lines-    ---- |-------continueHandler :: DebugCommandData -> MVar DebugContext -> J.ContinueRequest -> IO ()-continueHandler cmdData mvarCtx req = flip E.catches handlers $ do-  logRequest $ show req--  resSeq <- incResSeq mvarCtx-  let resStr = J.encode $ J.defaultContinueResponse resSeq req-  sendResponseL resStr--  startDebug cmdData mvarCtx--  where-    handlers = [ E.Handler someExcept ]-    someExcept (e :: E.SomeException) = do-      let msg = L.intercalate " " ["continue request error.", show req, show e]-      resSeq <- incResSeq mvarCtx-      sendResponseL $ J.encode $ J.errorContinueResponse resSeq req msg -      putStrLnStderr mvarCtx msg----- |-------stepOverHandler :: DebugCommandData -> MVar DebugContext -> J.NextRequest -> IO ()-stepOverHandler cmdData mvarCtx req = flip E.catches handlers $ do-  logRequest $ show req--  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)."}-      sendResponseL resStr-    Just _ -> stepOver--  where-    handlers = [ E.Handler someExcept ]-    someExcept (e :: E.SomeException) = do-      let msg = L.intercalate " " ["stepOver request error.", show req, show e]-      resSeq <- incResSeq mvarCtx-      sendResponseL $ J.encode $ J.errorNextResponse resSeq req msg -      putStrLnStderr mvarCtx 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-          sendResponseL resStr-    -          resSeq <- incResSeq mvarCtx-          let stopEvt    = J.defaultStoppedEvent resSeq-              stopEvtStr = J.encode stopEvt-          sendEventL stopEvtStr----- |-------stepInHandler :: DebugCommandData -> MVar DebugContext -> J.StepInRequest -> IO ()-stepInHandler cmdData mvarCtx req = flip E.catches handlers $ do-  logRequest $ show req--  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)."}-      sendResponseL resStr-    Just _ -> stepIn--  where-    handlers = [ E.Handler someExcept ]-    someExcept (e :: E.SomeException) = do-      let msg = L.intercalate " " ["stepIn request error.", show req, show e]-      resSeq <- incResSeq mvarCtx-      sendResponseL $ J.encode $ J.errorStepInResponse resSeq req msg -      putStrLnStderr mvarCtx 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-          sendEventL 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-          sendResponseL resStr-    -          resSeq <- incResSeq mvarCtx-          let stopEvt    = J.defaultStoppedEvent resSeq-              stopEvtStr = J.encode stopEvt-          sendEventL stopEvtStr------- |=====================================================================------  utility---- |-------putStrLnConsole :: MVar DebugContext -> String -> IO ()-putStrLnConsole mvarCtx msg = putStrConsole mvarCtx (msg ++ "\n")---- |-------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----- |-------logRequest :: String -> IO ()-logRequest reqStr = do-  let msg = L.intercalate " " ["[REQUEST]", reqStr]-  infoM _LOG_NAME msg------ |-------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 -> String -> FilePath -> IO Bool-runGHCi cmdData mvarCtx cmdStr cwd = do-  let startCmd  = startDebugCommandData cmdData-      readWhile = readWhileDebugCommandData cmdData-      cmdList = filter (not.null) $ Data.String.Utils.split " " cmdStr-      cmd  = head cmdList-      opts = tail cmdList-      cmdLogStr = L.intercalate " " $ cmd : opts-  infoM _LOG_NAME $ cmdLogStr ++ "\n"-  putStrLnStdout mvarCtx $ cmdLogStr ++ "\n"--  startCmd cmd opts cwd--  str <- readWhile $ not . endsWithPrompt--  infoM _LOG_NAME str-  putStrStdout mvarCtx str--  withStarted $ endsWithPrompt 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--    endsWithPrompt str =-      if endswith _GHCI_PROMPT str then True-        else isEndsWithPrompt $ last $ lines str-    -    ----- |-------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-         -         loadModule (last cont)-         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--    -- | -    --   Ok, modules loaded: Lib, Main, LibSpec.-    --    ->  : module +Lib Main LibSpec-    loadModule str = do-      let loadModule = moduleDebugCommandData cmdData-          getResult  = readDebugCommandData cmdData-          args = replace "," "" $ replace "Ok, modules loaded: " "+" $ init $ strip str- -      cmdStr <- loadModule args-      putStrLnStdout mvarCtx cmdStr-      infoM _LOG_NAME cmdStr--      cmdStr <- getResult-      putStrStdout mvarCtx cmdStr-      infoM _LOG_NAME cmdStr-  --- |---  ブレークポイントをGHCi上でdeleteする----deleteBreakPointOnCUI :: DebugCommandData -> MVar DebugContext -> BreakPointData -> IO ()-deleteBreakPointOnCUI cmdData _ (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 _ (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----- |---  Loggerのセットアップ--- -setupLogger :: FilePath -> Priority -> IO ()-setupLogger logFile level = do---  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----- |------ -watch :: DebugCommandData -> MVar DebugContext -> IO ()-watch cmdData mvarCtx = do-  _ <- forkIO $ watchFiles cmdData mvarCtx-  return ()--watchFiles :: DebugCommandData -> MVar DebugContext -> IO ()-watchFiles cmdData mvarCtx = do-  FSN.withManagerConf FSN.defaultConfig{FSN.confDebounce  = FSN.Debounce 1} $ \mgr -> do--    ctx <- readMVar mvarCtx-    let dir = workspaceDebugContext ctx-  -    infoM _LOG_NAME $ "start watch files in [" ++ dir ++ "]"-    _ <- FSN.watchTree mgr dir hsFilter action-  -    forever $ threadDelay 1000000--  return ()-  -  where-    hsFilter event = endswith _HS_FILE_EXT $ FSN.eventPath event--    action event = do--      ctx <- readMVar mvarCtx-      withDebugStarted event $ debugStartedDebugContext ctx--    withDebugStarted _ True = do-      resSeq <- incResSeq mvarCtx-      let terminatedEvt    = J.defaultTerminatedEvent resSeq-          terminatedEvtStr = J.encode terminatedEvt{J.bodyTerminatedEvent = J.TerminatedEventBody True}-      sendEvent terminatedEvtStr--    withDebugStarted event False = do-      ctx <- takeMVar mvarCtx-      putMVar mvarCtx ctx{modifiedDebugContext = True}-      loadHsFile cmdData mvarCtx (FSN.eventPath event) >> return ()----- |-------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----- |-------startDebug :: DebugCommandData -> MVar DebugContext -> IO ()-startDebug cmdData mvarCtx = do-  ctx <- readMVar mvarCtx-  let started = debugStartedDebugContext ctx-  -  startDebugInternal started---  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-      ctx <- readMVar mvarCtx-      withModified $ modifiedDebugContext ctx--    withModified True = do-      resSeq <- incResSeq mvarCtx-      let terminatedEvt    = J.defaultTerminatedEvent resSeq-          terminatedEvtStr = J.encode terminatedEvt{J.bodyTerminatedEvent = J.TerminatedEventBody True}-      sendEvent terminatedEvtStr-  -    withModified 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---      ctx <- takeMVar mvarCtx-      putMVar mvarCtx ctx{currentFrameIdDebugContext = 0, debugStartedDebugContext = True}--      sendEventByDebugStopStatus cmdData mvarCtx cmdStr------- |-------sendEventByDebugStopStatus :: DebugCommandData -> MVar DebugContext -> String -> IO ()-sendEventByDebugStopStatus cmdData 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 -> continueWithHighlightTextRangeData cmdData mvarCtx pos----- |-------continueWithHighlightTextRangeData :: DebugCommandData -> MVar DebugContext -> HighlightTextRangeData -> IO ()-continueWithHighlightTextRangeData cmdData mvarCtx pos = do-  ctx <- readMVar mvarCtx--  let bpKey = getKeyOfHighlightTextRangeData pos-      bpMap = breakPointDatasDebugContext ctx--  case MAP.lookup bpKey bpMap of-    Nothing -> do-      errorM _LOG_NAME $ "breakpoint not found." ++ show bpKey-      sendStopEvent-    Just condCmd -> continueWithCondCmd $ conditionBreakPointData condCmd--  where--    -- |-    ---    continueWithCondCmd Nothing = do-      infoM _LOG_NAME "no condition breakpoint"-      sendStopEvent-    continueWithCondCmd (Just condStr) = do-        -      let condition = execCommandData cmdData-          getResult = readDebugCommandData cmdData--      _ <- condition condStr-      infoM _LOG_NAME condStr-      putStrLnStdout mvarCtx condStr--      cmdStr <- getResult-      infoM _LOG_NAME cmdStr-      putStrStdout mvarCtx cmdStr--      condRes <- getConditionResult cmdStr--      continueWithCondResult condRes--    -- |-    ---    continueWithCondResult False = startDebug cmdData mvarCtx-    continueWithCondResult True  = sendStopEvent--    -- |-    ---    getConditionResult res-      | L.isPrefixOf "True"  res = return True-      | L.isPrefixOf "False" res = return False-      | otherwise = warningM _LOG_NAME ("invalid condition result. " ++ res) >> return True---    -- |-    ---    sendStopEvent = do-      infoM _LOG_NAME $ show pos-  -      ctx <- takeMVar mvarCtx-      putMVar mvarCtx ctx{debugStoppedPosDebugContext = Just pos}-  -      resSeq <- incResSeq mvarCtx-      let stopEvt    = J.defaultStoppedEvent resSeq-          stopEvtStr = J.encode stopEvt-      sendEvent stopEvtStr--------- |=====================================================================------  パーサ------- |-------getStoppedTextRangeData :: String -> Either ParseError HighlightTextRangeData-getStoppedTextRangeData = parse parser "getStoppedTextRangeData"-  where-    parser = try parse7 <|> try parse8-    parse7 = do-      _ <- manyTill anyChar (try (string "Stopped at "))-      parseHighlightTextRange--    parse8 = do-      _ <- manyTill anyChar (try (string "Stopped in "))-      _ <- manyTill anyChar (try (string ", "))-      parseHighlightTextRange---- |----drive2lower :: FilePath -> FilePath-drive2lower (x : ':' : xs) = toLower x : ':' : xs-drive2lower xs = xs---- |---  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 (drive2lower 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) (removeColorCode funcName) (init (strip filePath))---- |----removeColorCode :: String -> String-removeColorCode str = case parse parser "removeColorCode" str of-  Right res -> res-  Left _    -> str-  where-    parser = do-      let _esc_code = chr 27-      char _esc_code >> char '[' >> anyChar >> char 'm' -      funcName <- manyTill anyChar (char _esc_code)-      return funcName---- |---  バインディング値のパーサ------  parser of---   args :: Project.Argument.ArgData = _---   _result :: IO Data.ConfigFile.Types.ConfigParser = _----getBindingDataList :: String -> String -> Either ParseError [BindingData]-getBindingDataList prmpt res = parse parser "getBindingDataList" res-  where-    parser = manyTill parser1 (string prmpt)--    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----- |----isEndsWithPrompt :: String -> Bool-isEndsWithPrompt str = case parse parser "isEndsWithPrompt" str of-  Right res -> res-  Left _    -> False-  where-    parser = do-      char '*'-      manyTill anyChar $ char '>'-      space-      eof-      return True---
− app/Phoityne/IO/GUI/VSCode/TH/BreakpointJSON.hs 
@@ -1,25 +0,0 @@-{-# 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 
@@ -1,19 +0,0 @@-{-# 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 
@@ -1,23 +0,0 @@-{-# 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 
@@ -1,43 +0,0 @@-{-# 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" ""----- |----parceErrorContinueResponse :: Int -> String -> ContinueResponse-parceErrorContinueResponse seq msg =-  ContinueResponse seq "response" (-1) False "continue" msg---- |----errorContinueResponse :: Int -> ContinueRequest -> String -> ContinueResponse-errorContinueResponse seq (ContinueRequest reqSeq _ _ _) msg =-  ContinueResponse seq "response" reqSeq False "continue" msg
− app/Phoityne/IO/GUI/VSCode/TH/DisconnectArgumentsJSON.hs 
@@ -1,19 +0,0 @@-{-# 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 
@@ -1,23 +0,0 @@-{-# 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 
@@ -1,42 +0,0 @@-{-# 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" ""---- |----parceErrorDisconnectResponse :: Int -> String -> DisconnectResponse-parceErrorDisconnectResponse seq msg =-  DisconnectResponse seq "response" (-1) False "disconnect" msg---- |----errorDisconnectResponse :: Int -> DisconnectRequest -> String -> DisconnectResponse-errorDisconnectResponse seq (DisconnectRequest reqSeq _ _ _) msg =-  DisconnectResponse seq "response" reqSeq False "disconnect" msg
− app/Phoityne/IO/GUI/VSCode/TH/ErrorResponseBodyJSON.hs 
@@ -1,28 +0,0 @@-{-# 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 
@@ -1,31 +0,0 @@-{-# 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 
@@ -1,21 +0,0 @@-{-# 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 
@@ -1,28 +0,0 @@-{-# 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 
@@ -1,24 +0,0 @@-{-# 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 
@@ -1,40 +0,0 @@-{-# 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---- |----errorEvaluateResponse :: Int -> EvaluateRequest -> String -> EvaluateResponse-errorEvaluateResponse seq (EvaluateRequest reqSeq _ _ _) msg =-  EvaluateResponse seq "response" reqSeq False "evaluate" msg defaultEvaluateBody-
− app/Phoityne/IO/GUI/VSCode/TH/ExceptionBreakpointsFilterJSON.hs 
@@ -1,21 +0,0 @@-{-# 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 
@@ -1,23 +0,0 @@-{-# 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 
@@ -1,27 +0,0 @@-{-# 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 
@@ -1,23 +0,0 @@-{-# 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 
@@ -1,22 +0,0 @@-{-# 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 
@@ -1,31 +0,0 @@-{-# 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.-  , supportsStepBackInitializeResponseCapabilites                 :: Bool  -- The debug adapter supports stepping back.-  , supportsSetVariableInitializeResponseCapabilites              :: Bool  -- The debug adapter supports setting a variable to a value.-  } deriving (Show, Read, Eq)--$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "InitializeResponseCapabilites") } ''InitializeResponseCapabilites)---- |----defaultInitializeResponseCapabilites :: InitializeResponseCapabilites-defaultInitializeResponseCapabilites = InitializeResponseCapabilites False False False False [] False False-
− app/Phoityne/IO/GUI/VSCode/TH/InitializeResponseJSON.hs 
@@ -1,40 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}---module Phoityne.IO.GUI.VSCode.TH.InitializeResponseJSON where--import Data.Aeson.TH--import Phoityne.Utility-import Phoityne.IO.GUI.VSCode.TH.InitializeResponseCapabilitesJSON-import Phoityne.IO.GUI.VSCode.TH.InitializeRequestJSON---- |---   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)----- |----parseErrorInitializeResponse :: Int -> String -> InitializeResponse-parseErrorInitializeResponse seq msg =-  InitializeResponse seq "response" seq False "initialize" msg defaultInitializeResponseCapabilites---- |----errorInitializeResponse :: Int -> InitializeRequest -> String -> InitializeResponse-errorInitializeResponse seq (InitializeRequest reqSeq _ _ _) msg =-  InitializeResponse seq "response" reqSeq False "initialize" msg defaultInitializeResponseCapabilites-
− app/Phoityne/IO/GUI/VSCode/TH/InitializedEventJSON.hs 
@@ -1,23 +0,0 @@-{-# 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 
@@ -1,29 +0,0 @@-{-# 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    :: Maybe Bool --  If noDebug is true the launch request should launch the program without enabling debugging.-  , nameLaunchRequestArguments       :: String     -- Phoityne specific argument. required.-  , typeLaunchRequestArguments       :: String     -- Phoityne specific argument. required.-  , requestLaunchRequestArguments    :: String     -- Phoityne specific argument. required. must be "request"-  , startupLaunchRequestArguments    :: String     -- Phoityne specific argument. required.-  , workspaceLaunchRequestArguments  :: String     -- Phoityne specific argument. required.-  , logFileLaunchRequestArguments    :: String     -- Phoityne specific argument. required.-  , logLevelLaunchRequestArguments   :: String     -- Phoityne specific argument. required.-  , ghciPromptLaunchRequestArguments :: String     -- Phoityne specific argument. required.-  , ghciCmdLaunchRequestArguments    :: String     -- Phoityne specific argument. required.-  } deriving (Show, Read, Eq)---$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "LaunchRequestArguments") } ''LaunchRequestArguments)-
− app/Phoityne/IO/GUI/VSCode/TH/LaunchRequestJSON.hs 
@@ -1,23 +0,0 @@-{-# 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 
@@ -1,46 +0,0 @@-{-# 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" ""---- |----parceErrorLaunchResponse :: Int -> String -> LaunchResponse-parceErrorLaunchResponse seq msg =-  LaunchResponse seq "response" seq False "launch" msg---- |----errorLaunchResponse :: Int -> LaunchRequest -> String -> LaunchResponse-errorLaunchResponse seq (LaunchRequest reqSeq _ _ _) msg =-  LaunchResponse seq "response" reqSeq False "launch" msg---
− app/Phoityne/IO/GUI/VSCode/TH/MessageJSON.hs 
@@ -1,31 +0,0 @@-{-# 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 
@@ -1,19 +0,0 @@-{-# 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 
@@ -1,24 +0,0 @@-{-# 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 
@@ -1,40 +0,0 @@-{-# 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" ""----- |----errorNextResponse :: Int -> NextRequest -> String -> NextResponse-errorNextResponse seq (NextRequest reqSeq _ _ _) msg =-  NextResponse seq "response" reqSeq False "next" msg---
− app/Phoityne/IO/GUI/VSCode/TH/OutputEventBodyJSON.hs 
@@ -1,26 +0,0 @@-{-# 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 
@@ -1,25 +0,0 @@-{-# 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 
@@ -1,19 +0,0 @@-{-# 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 
@@ -1,24 +0,0 @@-{-# 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 
@@ -1,32 +0,0 @@-{-# 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 
@@ -1,18 +0,0 @@-{-# 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 
@@ -1,21 +0,0 @@-{-# 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 
@@ -1,19 +0,0 @@-{-# 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 
@@ -1,24 +0,0 @@-{-# 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 
@@ -1,23 +0,0 @@-{-# 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 
@@ -1,41 +0,0 @@-{-# 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----- |----errorScopesResponse :: Int -> ScopesRequest -> String -> ScopesResponse-errorScopesResponse seq (ScopesRequest reqSeq _ _ _) msg =-  ScopesResponse seq "response" reqSeq False "scopes" msg defaultScopesBody-
− app/Phoityne/IO/GUI/VSCode/TH/SetBreakpointsRequestArgumentsJSON.hs 
@@ -1,23 +0,0 @@-{-# 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 
@@ -1,25 +0,0 @@-{-# 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 
@@ -1,32 +0,0 @@-{-# 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 
@@ -1,45 +0,0 @@-{-# 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----- |----errorSetBreakpointsResponse :: Int -> SetBreakpointsRequest -> String -> SetBreakpointsResponse-errorSetBreakpointsResponse seq (SetBreakpointsRequest reqSeq _ _ _) msg =-  SetBreakpointsResponse seq "response" reqSeq False "setBreakpoints" msg defaultSetBreakpointsResponseBody-
− app/Phoityne/IO/GUI/VSCode/TH/SourceArgumentsJSON.hs 
@@ -1,19 +0,0 @@-{-# 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 
@@ -1,21 +0,0 @@-{-# 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 
@@ -1,22 +0,0 @@-{-# 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 
@@ -1,23 +0,0 @@-{-# 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 
@@ -1,28 +0,0 @@-{-# 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 
@@ -1,36 +0,0 @@-{-# 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 
@@ -1,26 +0,0 @@-{-# 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.-  , endLineStackFrame   :: Int  -- An optional end line of the range covered by the stack frame.-  , endColumnStackFrame :: Int  -- An optional end column of the range covered by the stack frame.-  } deriving (Show, Read, Eq)---$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "StackFrame") } ''StackFrame)
− app/Phoityne/IO/GUI/VSCode/TH/StackTraceArgumentsJSON.hs 
@@ -1,21 +0,0 @@-{-# 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 
@@ -1,29 +0,0 @@-{-# 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 
@@ -1,23 +0,0 @@-{-# 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 
@@ -1,40 +0,0 @@-{-# 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----- |----errorStackTraceResponse :: Int -> StackTraceRequest -> String -> StackTraceResponse-errorStackTraceResponse seq (StackTraceRequest reqSeq _ _ _) msg =-  StackTraceResponse seq "response" reqSeq False "stackTrace" msg defaultStackTraceBody-
− app/Phoityne/IO/GUI/VSCode/TH/StepInArgumentsJSON.hs 
@@ -1,19 +0,0 @@-{-# 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 
@@ -1,24 +0,0 @@-{-# 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 
@@ -1,38 +0,0 @@-{-# 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" ""----- |----errorStepInResponse :: Int -> StepInRequest -> String -> StepInResponse-errorStepInResponse seq (StepInRequest reqSeq _ _ _) msg =-  StepInResponse seq "response" reqSeq False "stepIn" msg-
− app/Phoityne/IO/GUI/VSCode/TH/StepOutArgumentsJSON.hs 
@@ -1,19 +0,0 @@-{-# 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 
@@ -1,24 +0,0 @@-{-# 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 
@@ -1,40 +0,0 @@-{-# 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" ""----- |----errorStepOutResponse :: Int -> StepOutRequest -> String -> StepOutResponse-errorStepOutResponse seq (StepOutRequest reqSeq _ _ _) msg =-  StepOutResponse seq "response" reqSeq False "stepOut" msg--
− app/Phoityne/IO/GUI/VSCode/TH/StoppedEventBodyJSON.hs 
@@ -1,31 +0,0 @@-{-# 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 
@@ -1,28 +0,0 @@-{-# 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 
@@ -1,23 +0,0 @@-{-# 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 
@@ -1,27 +0,0 @@-{-# 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 
@@ -1,21 +0,0 @@-{-# 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 
@@ -1,21 +0,0 @@-{-# 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 
@@ -1,28 +0,0 @@-{-# 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 
@@ -1,42 +0,0 @@-{-# 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----- |----errorThreadsResponse :: Int -> ThreadsRequest -> String -> ThreadsResponse-errorThreadsResponse seq (ThreadsRequest reqSeq _ _) msg =-  ThreadsResponse seq "response" reqSeq False "threads" msg defaultThreadsResponseBody-
− app/Phoityne/IO/GUI/VSCode/TH/VariableJSON.hs 
@@ -1,23 +0,0 @@-{-# 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-  , typeVariable               :: String  -- he variable's type.-  , valueVariable              :: String  -- The variable's value. For structured objects this can be a multi line text, e.g. for a function the body of a function.-  , 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 
@@ -1,19 +0,0 @@-{-# 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 
@@ -1,26 +0,0 @@-{-# 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 
@@ -1,23 +0,0 @@-{-# 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 
@@ -1,42 +0,0 @@-{-# 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---- |----errorVariablesResponse :: Int -> VariablesRequest -> String -> VariablesResponse-errorVariablesResponse seq (VariablesRequest reqSeq _ _ _) msg =-  VariablesResponse seq "response" reqSeq False "variables" msg defaultVariablesBody--
− app/Phoityne/IO/Main.hs 
@@ -1,81 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE MultiWayIf          #-}--module Phoityne.IO.Main (run) where---- モジュール-import qualified Phoityne.Argument as A-import qualified Phoityne.IO.Control as CTRL---- システム-import Data.Either.Utils-import qualified Control.Exception as E-import qualified Data.ConfigFile as C-import qualified System.Console.CmdArgs as CMD-import qualified System.Log.Logger as L----- |---  アプリケーションメイン--- -run :: IO Int-run = flip E.catches handlers $ do--  -- コマンドライン引数設定-  args <- getArgs--  -- INI設定ファイルのRead-  iniSet <- loadIniFile args--  -- ロジック実行-  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 _ = do-  let cp = forceEither $ C.readstring C.emptyCP defaultIniSetting-  return cp{ C.accessfunc = C.interpolatingAccess 5 }----- |--- デフォルトINI設定--- -defaultIniSetting :: String-defaultIniSetting = unlines [-    "[DEFAULT]"-  , "work_dir = ./"-  , ""-  , "[LOG]"-  , "file  = %(work_dir)sphoityne.log"-  , "level = WARNING"-  , ""-  , "[PHOITYNE]"-  ]-
− app/Phoityne/IO/Utility.hs 
@@ -1,48 +0,0 @@-{-# 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 
@@ -1,74 +0,0 @@--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-
+ app/Phoityne/VSCode/Argument.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE GADTs               #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE DeriveDataTypeable  #-}+{-# OPTIONS_GHC -fno-cse         #-}++module Phoityne.VSCode.Argument (+  HelpExitException(..)+, ArgData(..)+, config+) where++-- システム+import System.Console.CmdArgs+import qualified Control.Exception as E++import Paths_phoityne_vscode (version)+import Data.Version (showVersion)++-- |+--  ヘルプ表示時の例外+--+data HelpExitException = HelpExitException+                       deriving (Show, Typeable)++instance E.Exception HelpExitException++-- |+--  コマンドライン引数データ設定+--    モードを使用する場合のサンプル+--+data ArgData = ModeA deriving (Data, Typeable, Show, Read, Eq)++-- |+--  アノテーション設定+--+config :: ArgData+config = modes [confA]+         &= summary sumMsg+         &= program "phoityne-vscode"+         +  where+    confA = ModeA {++          } &= name "ModeA"+            &= details mdAMsg+            &= auto++    sumMsg = unlines [+             "phoityne-vscode-" ++ showVersion version+           ]+           +    mdAMsg = [+             ""+           , "Phoityne is a ghci debug viewer for Visual Studio Code. "+           , ""+           ]+++-- |+--  enum値引数+--+data Method = Get | Post | Put | Delete+              deriving (Data, Typeable, Show, Read, Eq)++
+ app/Phoityne/VSCode/Constant.hs view
@@ -0,0 +1,74 @@++module Phoityne.VSCode.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/VSCode/IO/Control.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE GADTs               #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE MultiWayIf          #-}+{-# LANGUAGE BinaryLiterals      #-}+{-# LANGUAGE TemplateHaskell     #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable  #-}++module Phoityne.VSCode.IO.Control where++-- モジュール+import Phoityne.VSCode.Utility+import qualified Phoityne.VSCode.Argument as A+import qualified Phoityne.VSCode.IO.Core as GUI+import qualified Data.ByteString.Lazy as BSL++-- システム+import System.IO+import Control.Concurrent+import qualified Data.ConfigFile as C+import Text.Parsec++-- |+--  ロジックメイン+-- +run :: A.ArgData      -- コマンドライン引数+    -> C.ConfigParser -- INI設定+    -> IO Int         -- exit code+run _ _ = do++  hSetBuffering stdin NoBuffering+  hSetEncoding  stdin utf8++  hSetBuffering stdout NoBuffering+  hSetEncoding  stdout utf8++  mvarDat <- newMVar GUI.defaultDebugContextData {GUI.responseHandlerDebugContextData = sendResponse}++  wait mvarDat++  return 1++-- |+--+-- +wait :: MVar GUI.DebugContextData -> IO ()+wait mvarDat = 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+          cnt <- BSL.hGet stdin len+          GUI.handleRequest mvarDat newBuf cnt+          wait mvarDat+    +      where+        readContentLength :: String -> Either ParseError Int+        readContentLength = parse parser "readContentLength"+    +        parser = do+          string "Content-Length: "+          len <- manyTill digit (string _TWO_CRLF)+          return . read $ len++-- |+--+sendResponse :: BSL.ByteString -> IO ()+sendResponse 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++-- |+--+--+_TWO_CRLF :: String+_TWO_CRLF = "\r\n\r\n"+
+ app/Phoityne/VSCode/IO/Core.hs view
@@ -0,0 +1,1632 @@+{-# LANGUAGE GADTs               #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE MultiWayIf          #-}+{-# LANGUAGE BinaryLiterals      #-}+{-# LANGUAGE TemplateHaskell     #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable  #-}++module Phoityne.VSCode.IO.Core (+  handleRequest+, DebugContextData(..)+, defaultDebugContextData+, initializeRequestHandler+) where++import Phoityne.VSCode.Constant+import Phoityne.VSCode.Utility+import Phoityne.VSCode.IO.Utility+import qualified Phoityne.VSCode.TH.BreakpointJSON as J+import qualified Phoityne.VSCode.TH.ContinueRequestJSON as J+import qualified Phoityne.VSCode.TH.ContinueResponseJSON as J+import qualified Phoityne.VSCode.TH.DisconnectRequestJSON as J+import qualified Phoityne.VSCode.TH.DisconnectResponseJSON as J+import qualified Phoityne.VSCode.TH.EvaluateArgumentsJSON as J+import qualified Phoityne.VSCode.TH.EvaluateBodyJSON as J+import qualified Phoityne.VSCode.TH.EvaluateRequestJSON as J+import qualified Phoityne.VSCode.TH.EvaluateResponseJSON as J+import qualified Phoityne.VSCode.TH.InitializedEventJSON as J+import qualified Phoityne.VSCode.TH.InitializeRequestJSON as J+import qualified Phoityne.VSCode.TH.InitializeResponseCapabilitesJSON as J+import qualified Phoityne.VSCode.TH.InitializeResponseJSON as J+import qualified Phoityne.VSCode.TH.LaunchRequestArgumentsJSON as J+import qualified Phoityne.VSCode.TH.LaunchRequestJSON as J+import qualified Phoityne.VSCode.TH.LaunchResponseJSON as J+import qualified Phoityne.VSCode.TH.NextRequestJSON as J+import qualified Phoityne.VSCode.TH.NextResponseJSON as J+import qualified Phoityne.VSCode.TH.OutputEventJSON as J+import qualified Phoityne.VSCode.TH.OutputEventBodyJSON as J+import qualified Phoityne.VSCode.TH.PauseRequestJSON as J+import qualified Phoityne.VSCode.TH.PauseResponseJSON as J+import qualified Phoityne.VSCode.TH.RequestJSON as J+import qualified Phoityne.VSCode.TH.ScopesArgumentsJSON as J+import qualified Phoityne.VSCode.TH.ScopesRequestJSON as J+import qualified Phoityne.VSCode.TH.ScopesResponseJSON as J+import qualified Phoityne.VSCode.TH.SetBreakpointsRequestArgumentsJSON as J+import qualified Phoityne.VSCode.TH.SetBreakpointsRequestJSON as J+import qualified Phoityne.VSCode.TH.SetBreakpointsResponseBodyJSON as J+import qualified Phoityne.VSCode.TH.SetBreakpointsResponseJSON as J+import qualified Phoityne.VSCode.TH.SetFunctionBreakpointsRequestArgumentsJSON as J+import qualified Phoityne.VSCode.TH.SetFunctionBreakpointsRequestJSON as J+import qualified Phoityne.VSCode.TH.SetFunctionBreakpointsResponseBodyJSON as J+import qualified Phoityne.VSCode.TH.SetFunctionBreakpointsResponseJSON as J+import qualified Phoityne.VSCode.TH.SourceBreakpointJSON as J+import qualified Phoityne.VSCode.TH.FunctionBreakpointJSON as J+import qualified Phoityne.VSCode.TH.SourceJSON as J+import qualified Phoityne.VSCode.TH.SourceRequestJSON as J+import qualified Phoityne.VSCode.TH.SourceResponseJSON as J+import qualified Phoityne.VSCode.TH.StackFrameJSON as J+import qualified Phoityne.VSCode.TH.StackTraceBodyJSON as J+import qualified Phoityne.VSCode.TH.StackTraceRequestJSON as J+import qualified Phoityne.VSCode.TH.StackTraceResponseJSON as J+import qualified Phoityne.VSCode.TH.StepInRequestJSON as J+import qualified Phoityne.VSCode.TH.StepInResponseJSON as J+import qualified Phoityne.VSCode.TH.StepOutRequestJSON as J+import qualified Phoityne.VSCode.TH.StepOutResponseJSON as J+import qualified Phoityne.VSCode.TH.StoppedEventJSON as J+import qualified Phoityne.VSCode.TH.TerminatedEventJSON as J+import qualified Phoityne.VSCode.TH.TerminatedEventBodyJSON as J+import qualified Phoityne.VSCode.TH.ThreadsRequestJSON as J+import qualified Phoityne.VSCode.TH.ThreadsResponseJSON as J+import qualified Phoityne.VSCode.TH.VariableJSON as J+import qualified Phoityne.VSCode.TH.VariablesBodyJSON as J+import qualified Phoityne.VSCode.TH.VariablesRequestJSON as J+import qualified Phoityne.VSCode.TH.VariablesResponseJSON as J++import qualified Phoityne.GHCi as G++import System.IO+import System.FilePath+import System.Directory+import System.Log.Logger+import qualified Data.Aeson as J+import qualified Data.ByteString.Lazy as BSL+import qualified Data.String.Utils as U+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 Control.Monad+import qualified System.FSNotify as FSN+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+import Safe+import Text.Parsec++-- |+--+--+data DebugContextData = +  DebugContextData {+    resSeqDebugContextData                  :: Int+  , functionBreakPointDatasDebugContextData :: BreakPointDatas+  , breakPointDatasDebugContextData         :: BreakPointDatas+  , workspaceDebugContextData               :: FilePath+  , startupDebugContextData                 :: FilePath+  , debugStartedDebugContextData            :: Bool+  , debugStoppedPosDebugContextData         :: Maybe G.SourcePosition+  , currentFrameIdDebugContextData          :: Int+  , modifiedDebugContextData                :: Bool+  , ghciProcessDebugContextData             :: Maybe G.GHCiProcess+  , responseHandlerDebugContextData         :: BSL.ByteString -> IO ()+  }+++-- |+--  +-- +data BreakPointData =+  BreakPointData {+    nameBreakPointData :: String+  , filePathBreakPointData   :: FilePath+  , lineNoBreakPointData     :: Int+  , breakNoBreakPointData    :: Maybe Int+  , conditionBreakPointData  :: Maybe 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 = '/'++-- |+--+--+_TASKS_JSON_FILE_CONTENTS :: BSL.ByteString+_TASKS_JSON_FILE_CONTENTS = str2lbs $ U.join "\n" $+  [+    "{"+  , "  // atuomatically created by phoityne-vscode"+  , "  "+  , "  \"version\": \"0.1.0\","+  , "  \"isShellCommand\": true,"+  , "  \"showOutput\": \"always\","+  , "  \"suppressTaskName\": true,"+  , "  \"windows\": {"+  , "    \"command\": \"cmd\","+  , "    \"args\": [\"/c\"]"+  , "  },"+  , "  \"linux\": {"+  , "    \"command\": \"sh\","+  , "    \"args\": [\"-c\"]"+  , "  },"+  , "  \"osx\": {"+  , "    \"command\": \"sh\","+  , "    \"args\": [\"-c\"]"+  , "  },"+  , "  \"tasks\": ["+  , "    {"+  , "       \"taskName\": \"stack build\","+  , "       \"args\": [ \"echo START_STACK_BUILD && cd ${workspaceRoot} && stack build && echo END_STACK_BUILD \" ]"+  , "    },"+  , "    { "+  , "       \"isBuildCommand\": true,"+  , "       \"taskName\": \"stack clean & build\","+  , "       \"args\": [ \"echo START_STACK_CLEAN_AND_BUILD && cd ${workspaceRoot} && stack clean && stack build && echo END_STACK_CLEAN_AND_BUILD \" ]"+  , "    },"+  , "    { "+  , "       \"isTestCommand\": true,"+  , "       \"taskName\": \"stack test\","+  , "       \"args\": [ \"echo START_STACK_TEST && cd ${workspaceRoot} && stack test && echo END_STACK_TEST \" ]"+  , "    },"+  , "    { "+  , "       \"isWatching\": true,"+  , "       \"taskName\": \"stack watch\","+  , "       \"args\": [ \"echo START_STACK_WATCH && cd ${workspaceRoot} && stack build --test --no-run-tests --file-watch && echo END_STACK_WATCH \" ]"+  , "    }"+  , "  ]"+  , "}"+  ]+++-- |+--+--+_ERR_MSG_URL :: [String]+_ERR_MSG_URL = [ "`stack update` and install new phoityen-vscode."+               , "Or check information on https://marketplace.visualstudio.com/items?itemName=phoityne.phoityne-vscode"+               ]+++-- |+--+--+defaultDebugContextData :: DebugContextData+defaultDebugContextData = DebugContextData _INITIAL_RESPONSE_SEQUENCE (MAP.fromList []) (MAP.fromList []) "" "" False Nothing 0 False Nothing BSL.putStr++-- |+--+--+getKeyOfSourcePosition :: G.SourcePosition -> BreakPointDataKey+getKeyOfSourcePosition (G.SourcePosition file line _ _ _) = (file, line)+++-- |+--+--+handleRequest :: MVar DebugContextData -> BSL.ByteString -> BSL.ByteString -> IO ()+handleRequest mvarDat contLenStr jsonStr = do+  case J.eitherDecode jsonStr :: Either String J.Request of+    Left  err -> do+      -- req_secが不明のため、エラー出力のみ行う。+      -- ただし、initializeが完了していない場合は、エラー出力イベントが受理されない。+      -- launchしていな場合はログ出力ができない。+      -- 無視して、次のリクエストを待つ。+      let msg =  L.intercalate " " [ "request request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+              ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL)+              ++ "\n"++      sendErrorEvent mvarDat msg++      resSeq <- getIncreasedResponseSequence mvarDat+      let terminatedEvt    = J.defaultTerminatedEvent resSeq+          terminatedEvtStr = J.encode terminatedEvt+      sendEventL terminatedEvtStr++    Right (J.Request cmd) -> handle contLenStr jsonStr cmd++  where++    handle contLenStr jsonStr "initialize" = case J.eitherDecode jsonStr :: Either String J.InitializeRequest of+      Right req -> initializeRequestHandler mvarDat req+      Left  err -> do+        -- initializeが完了していない場合は、エラー出力イベントが受理されない。+        -- responceをエラーで返す。メッセージは1行で作成する必要がある。+        -- launchしていな場合はログ出力ができない。+        -- res_seqは1固定とする。+        let msg = L.intercalate " " $ ["initialize request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err] ++ _ERR_MSG_URL+        resSeq <- getIncreasedResponseSequence mvarDat+        sendResponse $ J.encode $ J.parseErrorInitializeResponse resSeq msg+++    handle contLenStr jsonStr "launch" = case J.eitherDecode jsonStr :: Either String J.LaunchRequest of+      Right req -> launchRequestHandler mvarDat req+      Left  err -> do+        -- launchしていな場合はログ出力ができない。+        -- req_secが不明のため、エラー出力のみ行う。+        let msg = L.intercalate " " ["launch request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"+        sendErrorEvent mvarDat msg++        resSeq <- getIncreasedResponseSequence mvarDat+        let terminatedEvt    = J.defaultTerminatedEvent resSeq+            terminatedEvtStr = J.encode terminatedEvt+        sendEventL terminatedEvtStr+++    handle contLenStr jsonStr "disconnect" = case J.eitherDecode jsonStr :: Either String J.DisconnectRequest of+      Right req -> disconnectRequestHandler mvarDat req+      Left  err -> do+        let msg = L.intercalate " " ["disconnect request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"+        sendErrorEvent mvarDat msg+++    handle contLenStr jsonStr "setBreakpoints" = case J.eitherDecode jsonStr :: Either String J.SetBreakpointsRequest of+      Right req -> setBreakpointsRequestHandler mvarDat req+      Left  err -> do+        let msg = L.intercalate " " ["setBreakpoints request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"+        sendErrorEvent mvarDat msg+++    handle contLenStr jsonStr "setFunctionBreakpoints" = case J.eitherDecode jsonStr :: Either String J.SetFunctionBreakpointsRequest of+      Right req -> setFunctionBreakpointsRequestHandler mvarDat req+      Left  err -> do+        let msg = L.intercalate " " ["setFunctionBreakpoints request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"+        sendErrorEvent mvarDat msg+++    handle contLenStr jsonStr "continue" = case J.eitherDecode jsonStr :: Either String J.ContinueRequest of+      Right req -> continueRequestHandler mvarDat req+      Left  err -> do+        let msg = L.intercalate " " ["continue request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"+        sendErrorEvent mvarDat msg+++    handle contLenStr jsonStr "next" = case J.eitherDecode jsonStr :: Either String J.NextRequest of+      Right req -> nextRequestHandler mvarDat req+      Left  err -> do+        let msg = L.intercalate " " ["next request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"+        sendErrorEvent mvarDat msg+++    handle contLenStr jsonStr "stepIn" = case J.eitherDecode jsonStr :: Either String J.StepInRequest of+      Right req -> stepInRequestHandler mvarDat req+      Left  err -> do+        let msg = L.intercalate " " ["stepIn request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"+        sendErrorEvent mvarDat msg++    -- |+    --  not supported.+    --+    handle contLenStr jsonStr "stepOut" = case J.eitherDecode jsonStr :: Either String J.StepOutRequest of+      Right req -> do+        resSeq <- getIncreasedResponseSequence mvarDat+        let res    = J.defaultStepOutResponse resSeq req+            resStr = J.encode $ res{J.successStepOutResponse = False, J.messageStepOutResponse = "unsupported command."}+        sendResponse resStr+ +        sendErrorEvent mvarDat "stepOut command is not supported."++      Left  err -> do+        let msg = L.intercalate " " ["stepOut request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"+        sendErrorEvent mvarDat msg++    -- |+    --  not supported.+    --+    handle contLenStr jsonStr "pause" = case J.eitherDecode jsonStr :: Either String J.PauseRequest of+      Right req -> do+        resSeq <- getIncreasedResponseSequence mvarDat+        let res    = J.defaultPauseResponse resSeq req+            resStr = J.encode $ res{J.successPauseResponse = False, J.messagePauseResponse = "unsupported command."}+        sendResponse resStr+ +        sendErrorEvent  mvarDat "pause command is not supported."++      Left  err -> do+        let msg = L.intercalate " " ["pause request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"+        sendErrorEvent  mvarDat msg+++    handle contLenStr jsonStr "stackTrace" = case J.eitherDecode jsonStr :: Either String J.StackTraceRequest of+      Right req -> stackTraceRequestHandler mvarDat req+      Left  err -> do+        let msg = L.intercalate " " ["stackTrace request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"+        sendErrorEvent  mvarDat msg+++    handle contLenStr jsonStr "scopes" = case J.eitherDecode jsonStr :: Either String J.ScopesRequest of+      Right req -> scopesRequestHandler mvarDat req+      Left  err -> do+        let msg = L.intercalate " " ["scopes request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"+        sendErrorEvent mvarDat msg+++    handle contLenStr jsonStr "variables" = case J.eitherDecode jsonStr :: Either String J.VariablesRequest of+      Right req -> variablesRequestHandler mvarDat req+      Left  err -> do+        let msg = L.intercalate " " ["variables request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"+        sendErrorEvent mvarDat msg++    -- |+    --  not supported.+    --+    handle contLenStr jsonStr "source" = case J.eitherDecode jsonStr :: Either String J.SourceRequest of+      Right req -> do+        resSeq <- getIncreasedResponseSequence mvarDat+        let res    = J.defaultSourceResponse resSeq req+            resStr = J.encode $ res{J.successSourceResponse = False, J.messageSourceResponse = "unsupported command."}+        sendResponse resStr+ +        sendErrorEvent  mvarDat "source command is not supported."++      Left  err -> do+        let msg = L.intercalate " " ["source request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"+        sendErrorEvent mvarDat msg+++    handle contLenStr jsonStr "threads" = case J.eitherDecode jsonStr :: Either String J.ThreadsRequest of+      Right req -> threadsRequestHandler mvarDat req+      Left  err -> do+        let msg = L.intercalate " " ["threads request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"+        sendErrorEvent mvarDat msg+++    handle contLenStr jsonStr "evaluate" = case J.eitherDecode jsonStr :: Either String J.EvaluateRequest of+      Right req -> evaluateRequestHandler mvarDat req+      Left  err -> do+        let msg = L.intercalate " " ["evaluate request parce error.", lbs2str contLenStr, lbs2str jsonStr, show err]+                ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL) ++ "\n"+        sendErrorEvent mvarDat msg+++    handle contLenStr jsonStr cmd = do+      let msg = L.intercalate " " ["unknown request command.", cmd, lbs2str contLenStr, lbs2str jsonStr]+      sendErrorEvent mvarDat msg+++-- |+--+sendEvent :: BSL.ByteString -> IO ()+sendEvent str = sendResponseInternal str++-- |+--+sendEventL :: BSL.ByteString -> IO ()+sendEventL str = do+  infoM _LOG_NAME $ "[EVENT]" ++ lbs2str str+  sendEvent str+++-- |+--+sendResponseL :: BSL.ByteString -> IO ()+sendResponseL str = do+  infoM _LOG_NAME $ "[RESPONSE]" ++ lbs2str str+  sendResponse str+++-- |+--+sendResponse :: BSL.ByteString -> IO ()+sendResponse str = sendResponseInternal str++-- |+--+sendResponse2 :: MVar DebugContextData -> BSL.ByteString -> IO ()+sendResponse2 mvarCtx str = do+  ctx <- readMVar mvarCtx+  responseHandlerDebugContextData ctx $ 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++-- |+--+--+sendConsoleEvent :: MVar DebugContextData -> String -> IO ()+sendConsoleEvent mvarCtx msg = do+  resSeq <- getIncreasedResponseSequence mvarCtx+  let outEvt  = J.defaultOutputEvent resSeq+      outEvtStr = J.encode outEvt{J.bodyOutputEvent = J.OutputEventBody "console" msg Nothing }+  sendEvent outEvtStr++-- |+--+--+sendStdoutEvent :: MVar DebugContextData -> String -> IO ()+sendStdoutEvent mvarCtx msg = do+  resSeq <- getIncreasedResponseSequence mvarCtx+  let outEvt    = J.defaultOutputEvent resSeq+      outEvtStr = J.encode outEvt{J.bodyOutputEvent = J.OutputEventBody "stdout" msg Nothing }+  sendEvent outEvtStr++-- |+--+--+sendErrorEvent :: MVar DebugContextData -> String -> IO ()+sendErrorEvent mvarCtx msg = do+  resSeq <- getIncreasedResponseSequence mvarCtx+  let outEvt    = J.defaultOutputEvent resSeq+      outEvtStr = J.encode outEvt{J.bodyOutputEvent = J.OutputEventBody "stderr" msg Nothing }+  sendEvent outEvtStr++-- |=====================================================================+--+-- Handlers++-- |+--+initializeRequestHandler :: MVar DebugContextData -> J.InitializeRequest -> IO ()+initializeRequestHandler mvarCtx req@(J.InitializeRequest seq _ _ _) = flip E.catches handlers $ do+  resSeq <- getIncreasedResponseSequence mvarCtx+  let capa = J.InitializeResponseCapabilites False True True True [] False False False False False False+      res  = J.InitializeResponse resSeq "response" seq True "initialize" "" capa++  sendResponse2 mvarCtx $ J.encode res++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = L.intercalate " " ["initialize request error.", show req, show e]+      resSeq <- getIncreasedResponseSequence mvarCtx+      sendResponse $ J.encode $ J.errorInitializeResponse resSeq req msg +      sendErrorEvent mvarCtx msg+++-- |+--+launchRequestHandler :: MVar DebugContextData -> J.LaunchRequest -> IO ()+launchRequestHandler mvarCtx req@(J.LaunchRequest _ _ _ args) = flip E.catches handlers $ do+  let ws = J.workspaceLaunchRequestArguments args+      su = J.startupLaunchRequestArguments args+      logFile     = J.logFileLaunchRequestArguments args+      logLevelStr = J.logLevelLaunchRequestArguments args+      prmptStr    = J.ghciPromptLaunchRequestArguments args+      cmdStr      = J.ghciCmdLaunchRequestArguments args++  -- コンテキストデータの保持+  ctx <- takeMVar mvarCtx+  putMVar mvarCtx ctx {+      workspaceDebugContextData = ws+    , startupDebugContextData   = su+    }++  -- ロギング設定+  logLevel <- case readMay logLevelStr of+    Just lv -> return lv+    Nothing -> do+      sendErrorEvent mvarCtx $ "log priority is invalid. WARNING set. [" ++ logLevelStr ++ "]\n"+      return WARNING++  setupLogger logFile logLevel++  logRequest $ show req++  -- tasks.jsonファイルの準備+  prepareTasksJsonFile mvarCtx ws +++  -- ghciのランチ+  runGHCi mvarCtx cmdStr ws prmptStr >>= ghciLaunched ++    +  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = L.intercalate " " ["launch request error.", show req, show e]+      resSeq <- getIncreasedResponseSequence mvarCtx+      sendResponse $ J.encode $ J.errorLaunchResponse resSeq req msg +      sendErrorEvent mvarCtx $ msg ++ "\n"++    -- |+    -- +    prepareTasksJsonFile :: MVar DebugContextData -> FilePath -> IO ()+    prepareTasksJsonFile mvarCtx ws = do+      let jsonFile = ws </> ".vscode" </> "tasks.json"+    +      doesFileExist jsonFile >>= \case+        True  -> infoM _LOG_NAME $ "tasks.json file exists. " ++ jsonFile +        False -> do+          sendConsoleEvent mvarCtx $ "create tasks.json file. " ++ jsonFile ++ "\n"+          saveFileLBS jsonFile _TASKS_JSON_FILE_CONTENTS++    -- |+    -- +    ghciLaunched (Left err) = do+      let msg = L.intercalate " " ["ghci launch error.", err]+      resSeq <- getIncreasedResponseSequence mvarCtx+      sendResponse $ J.encode $ J.errorLaunchResponse resSeq req msg +      sendErrorEvent mvarCtx $ msg ++ "\n"++    ghciLaunched (Right ghciProc) = do+      ctx <- takeMVar mvarCtx+      putMVar mvarCtx ctx{ghciProcessDebugContextData = Just ghciProc}++      startupRes <- loadHsFile mvarCtx (J.startupLaunchRequestArguments args)++      when (False == startupRes) $ do+        let msg = L.intercalate " " ["startup load error.", J.startupLaunchRequestArguments args]+        sendErrorEvent mvarCtx $ msg ++ "\n"++      -- レスポンスとinitializedイベント送信+      resSeq <- getIncreasedResponseSequence mvarCtx+      sendResponseL $ J.encode $ J.defaultLaunchResponse resSeq req+    +      resSeq <- getIncreasedResponseSequence mvarCtx+      sendEventL $ J.encode $ J.defaultInitializedEvent resSeq+    +      -- ファイル変更ウォッチの開始+      watch mvarCtx+    +      sendConsoleEvent mvarCtx $ L.intercalate "\n" infoMsg+      sendStdoutEvent mvarCtx $ J.ghciPromptLaunchRequestArguments args+    +    -- ランチ完了後のメッセージ出力+    infoMsg = [+              ""+            , "  Now, ghci initialized."+            , "  Press F5 to start debugging."+            , "  Or modify source code. it will be loaded to ghci automatically."+            , " "+            ]++-- |+--+disconnectRequestHandler :: MVar DebugContextData -> J.DisconnectRequest -> IO ()+disconnectRequestHandler mvarCtx req = flip E.catches handlers $ do+  logRequest $ show req+  ghciProcessDebugContextData <$> (readMVar mvarCtx) >>= withProcess++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = L.intercalate " " ["disconnect request error.", show req, show e]+      resSeq <- getIncreasedResponseSequence mvarCtx+      sendResponseL $ J.encode $ J.errorDisconnectResponse resSeq req msg +      sendErrorEvent mvarCtx msg++    withProcess Nothing = do+      errorM _LOG_NAME "[disconnectRequestHandler] ghci not started."+      sendErrorEvent mvarCtx "[disconnectRequestHandler] ghci not started."++    withProcess (Just ghciProc) = G.quit ghciProc outHdl >>= withExitCode++    withExitCode (Left err)  = do+      errorM _LOG_NAME $ "[disconnectRequestHandler] ghci quit error. " ++ err+      sendErrorEvent mvarCtx $ "[disconnectRequestHandler] ghci quit error. " ++ err++    withExitCode (Right code) = do+      infoM _LOG_NAME $ show code+      sendStdoutEvent mvarCtx $ show code+      resSeq <- getIncreasedResponseSequence mvarCtx+      sendResponseL $ J.encode $ J.defaultDisconnectResponse resSeq req++    outHdl msg = do+      sendStdoutEvent mvarCtx msg+      infoM _LOG_NAME msg+++-- |+--+setBreakpointsRequestHandler :: MVar DebugContextData -> J.SetBreakpointsRequest -> IO ()+setBreakpointsRequestHandler mvarCtx req = flip E.catches handlers $ do+  logRequest $ show req++  ctx <- readMVar mvarCtx+  let cwd     = workspaceDebugContextData 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 <- getIncreasedResponseSequence mvarCtx+  let res    = J.defaultSetBreakpointsResponse resSeq req+      resStr = J.encode res{J.bodySetBreakpointsResponse = J.SetBreakpointsResponseBody resBody}+  sendResponseL resStr++  resSeq <- getIncreasedResponseSequence mvarCtx+  let stopEvt    = J.defaultStoppedEvent resSeq+      stopEvtStr = J.encode stopEvt+  sendEventL stopEvtStr+++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = L.intercalate " " ["setBreakpoints request error.", show req, show e]+      resSeq <- getIncreasedResponseSequence mvarCtx+      sendResponseL $ J.encode $ J.errorSetBreakpointsResponse resSeq req msg +      sendErrorEvent mvarCtx msg++    convBp cwd path (J.SourceBreakpoint lineNo _ cond) =+      BreakPointData {+        nameBreakPointData       = src2mod cwd path+      , filePathBreakPointData   = path+      , lineNoBreakPointData     = lineNo+      , breakNoBreakPointData    = Nothing+      , conditionBreakPointData  = normalizeCond cond+      }++    normalizeCond Nothing = Nothing+    normalizeCond (Just c)+      | null (U.strip c) = Nothing+      | otherwise = Just c++    delete path = do+      ctx <- takeMVar mvarCtx+      let bps = breakPointDatasDebugContextData ctx+          newBps = MAP.filterWithKey (\(p,_) _-> path /= p) bps+          delBps = MAP.elems $ MAP.filterWithKey (\(p,_) _-> path == p) bps++      putMVar mvarCtx ctx{breakPointDatasDebugContextData = newBps}++      debugM _LOG_NAME $ "del bps:" ++ show delBps++      mapM_ (deleteBreakPointOnGHCi 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    = breakPointDatasDebugContextData ctx+          newBps = foldr (\v@(BreakPointData _ p l _ _)->MAP.insert (p,l) v) bps $ map fst results+      putMVar mvarCtx ctx{breakPointDatasDebugContextData = newBps}++      return resData+++    insertInternal reqBp@(BreakPointData modName filePath lineNo _ _) = do+      let src = J.Source (Just modName) filePath Nothing Nothing ++      addBreakPointOnGHCi mvarCtx reqBp >>= \case+        Right no -> do+          --putStrLnStdout mvarCtx $ "set breakpoint on " ++ filePathBreakPointData reqBp ++ ":L" ++ show (lineNoBreakPointData reqBp) +          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)++-- |+--+setFunctionBreakpointsRequestHandler :: MVar DebugContextData -> J.SetFunctionBreakpointsRequest -> IO ()+setFunctionBreakpointsRequestHandler mvarCtx req = flip E.catches handlers $ do+  logRequest $ show req++  let args    = J.argumentsSetFunctionBreakpointsRequest req+      reqBps  = J.breakpointsSetFunctionBreakpointsRequestArguments args+      bps     = map convBp reqBps++  delete+  resBody <- insert bps++  resSeq <- getIncreasedResponseSequence mvarCtx+  let res    = J.defaultSetFunctionBreakpointsResponse resSeq req+      resStr = J.encode res{J.bodySetFunctionBreakpointsResponse = J.SetFunctionBreakpointsResponseBody resBody}+  sendResponseL resStr++  resSeq <- getIncreasedResponseSequence mvarCtx+  let stopEvt    = J.defaultStoppedEvent resSeq+      stopEvtStr = J.encode stopEvt+  sendEventL stopEvtStr+++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = L.intercalate " " ["setBreakpoints request error.", show req, show e]+      resSeq <- getIncreasedResponseSequence mvarCtx+      sendResponseL $ J.encode $ J.errorSetFunctionBreakpointsResponse resSeq req msg +      sendErrorEvent mvarCtx msg++    convBp (J.FunctionBreakpoint name cond) =+      BreakPointData {+        nameBreakPointData       = name+      , filePathBreakPointData   = ""+      , lineNoBreakPointData     = -1+      , breakNoBreakPointData    = Nothing+      , conditionBreakPointData  = normalizeCond cond+      }++    normalizeCond Nothing = Nothing+    normalizeCond (Just c)+      | null (U.strip c) = Nothing+      | otherwise = Just c++    delete = do+      ctx <- takeMVar mvarCtx+      let bps = functionBreakPointDatasDebugContextData ctx+          delBps = MAP.elems bps++      putMVar mvarCtx ctx{functionBreakPointDatasDebugContextData = MAP.fromList []}++      debugM _LOG_NAME $ "del bps:" ++ show delBps++      mapM_ (deleteBreakPointOnGHCi 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 funBPs:" ++ show addBps+      debugM _LOG_NAME $ "response funBPs:" ++ show resData++      ctx <- takeMVar mvarCtx+      let bps    = functionBreakPointDatasDebugContextData ctx+          newBps = foldr (\v@(BreakPointData _ p l _ _)->MAP.insert (p,l) v) bps $ map fst results+      putMVar mvarCtx ctx{functionBreakPointDatasDebugContextData = newBps}++      return resData+++    insertInternal reqBp@(BreakPointData funcName _ _ _ _) = do+      addFunctionBreakPointOnGHCi mvarCtx reqBp >>= \case+        Right (no, (G.SourcePosition path sl sc _ _)) -> do+          --putStrLnStdout mvarCtx $ "set breakpoint on " ++ filePathBreakPointData reqBp ++ ":L" ++ show (lineNoBreakPointData reqBp) +          return ( reqBp{ breakNoBreakPointData  = Just no+                        , filePathBreakPointData = path+                        , lineNoBreakPointData   = sl+                        }+                 , J.Breakpoint (Just no) True "" (J.Source (Just funcName) path Nothing Nothing) sl sc)+        Left err -> return (reqBp, J.Breakpoint Nothing False err (J.Source (Just funcName) "" Nothing Nothing) (-1) (-1))++-- |+--+--+continueRequestHandler :: MVar DebugContextData -> J.ContinueRequest -> IO ()+continueRequestHandler mvarCtx req = flip E.catches handlers $ do+  logRequest $ show req+  ghciProcessDebugContextData <$> (readMVar mvarCtx) >>= withProcess+  +  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = L.intercalate " " ["continue request error.", show req, show e]+      resSeq <- getIncreasedResponseSequence mvarCtx+      sendResponseL $ J.encode $ J.errorContinueResponse resSeq req msg +      sendErrorEvent mvarCtx msg++    withProcess Nothing = do+      errorM _LOG_NAME "[continueRequestHandler] ghci not started."+      sendErrorEvent mvarCtx "[continueRequestHandler] ghci not started."++    withProcess (Just _) = do+      resSeq <- getIncreasedResponseSequence mvarCtx+      let resStr = J.encode $ J.defaultContinueResponse resSeq req+      sendResponseL resStr++      startDebug mvarCtx+++-- |+--+--+nextRequestHandler :: MVar DebugContextData -> J.NextRequest -> IO ()+nextRequestHandler mvarCtx req = flip E.catches handlers $ do+  logRequest $ show req++  ctx <- readMVar mvarCtx+  case debugStoppedPosDebugContextData ctx of+    Nothing -> do+      resSeq <- getIncreasedResponseSequence 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)."}+      sendResponseL resStr+    Just _ -> next++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = L.intercalate " " ["stepOver request error.", show req, show e]+      resSeq <- getIncreasedResponseSequence mvarCtx+      sendResponseL $ J.encode $ J.errorNextResponse resSeq req msg +      sendErrorEvent mvarCtx msg++    next = ghciProcessDebugContextData <$> (readMVar mvarCtx) >>= withProcess++    withProcess Nothing = do+      errorM _LOG_NAME "[nextRequestHandler] ghci not started."+      sendErrorEvent mvarCtx "[nextRequestHandler] ghci not started."++    withProcess (Just ghciProc) = G.stepLocal ghciProc outHdl >>= \case+      Left err  -> do+        infoM _LOG_NAME $ show err+        --putStrLnStdout mvarCtx $ show err+    +        resSeq <- getIncreasedResponseSequence mvarCtx+        let terminatedEvt    = J.defaultTerminatedEvent resSeq+            terminatedEvtStr = J.encode terminatedEvt+        sendEventL terminatedEvtStr++      Right pos -> do+        ctx <- takeMVar mvarCtx+        putMVar mvarCtx ctx{debugStoppedPosDebugContextData = Just pos}+  +        resSeq <- getIncreasedResponseSequence mvarCtx+        let res    = J.defaultNextResponse resSeq req+            resStr = J.encode res+        sendResponseL resStr+  +        resSeq <- getIncreasedResponseSequence mvarCtx+        let stopEvt    = J.defaultStoppedEvent resSeq+            stopEvtStr = J.encode stopEvt+        sendEventL stopEvtStr++    outHdl msg = do+      sendStdoutEvent mvarCtx msg+      infoM _LOG_NAME msg+++-- |+--+--+stepInRequestHandler :: MVar DebugContextData -> J.StepInRequest -> IO ()+stepInRequestHandler mvarCtx req = flip E.catches handlers $ do+  logRequest $ show req++  ctx <- readMVar mvarCtx+  case debugStoppedPosDebugContextData ctx of+    Nothing -> do+      resSeq <- getIncreasedResponseSequence 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)."}+      sendResponseL resStr+    Just _ -> stepIn++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = L.intercalate " " ["stepIn request error.", show req, show e]+      resSeq <- getIncreasedResponseSequence mvarCtx+      sendResponseL $ J.encode $ J.errorStepInResponse resSeq req msg +      sendErrorEvent mvarCtx msg++    stepIn = ghciProcessDebugContextData <$> (readMVar mvarCtx) >>= withProcess++    withProcess Nothing = do+      errorM _LOG_NAME "[stepInRequestHandler] ghci not started."+      sendErrorEvent mvarCtx "[stepInRequestHandler] ghci not started."++    withProcess (Just ghciProc) = G.step ghciProc outHdl >>= \case+      Left err  -> do+        infoM _LOG_NAME $ show err+        --putStrLnStdout mvarCtx $ show err+    +        resSeq <- getIncreasedResponseSequence mvarCtx+        let terminatedEvt    = J.defaultTerminatedEvent resSeq+            terminatedEvtStr = J.encode terminatedEvt+        sendEventL terminatedEvtStr++      Right pos -> do+        ctx <- takeMVar mvarCtx+        putMVar mvarCtx ctx{debugStoppedPosDebugContextData = Just pos}+  +        resSeq <- getIncreasedResponseSequence mvarCtx+        let res    = J.defaultStepInResponse resSeq req+            resStr = J.encode res+        sendResponseL resStr+  +        resSeq <- getIncreasedResponseSequence mvarCtx+        let stopEvt    = J.defaultStoppedEvent resSeq+            stopEvtStr = J.encode stopEvt+        sendEventL stopEvtStr++    outHdl msg = do+      sendStdoutEvent mvarCtx msg+      infoM _LOG_NAME msg+++-- |+--+--+stackTraceRequestHandler :: MVar DebugContextData -> J.StackTraceRequest -> IO ()+stackTraceRequestHandler mvarCtx req = flip E.catches handlers $ do+  logRequest $ show req++  ctx <- readMVar mvarCtx+  case debugStoppedPosDebugContextData ctx of+    Nothing -> do+      resSeq <- getIncreasedResponseSequence mvarCtx+      let body = J.StackTraceBody [] 0+          res  = J.defaultStackTraceResponse resSeq req+          resStr = J.encode $ res{J.bodyStackTraceResponse = body}+      sendResponseL resStr+    +    Just rangeData -> do+      frames <- createStackFrames rangeData+      debugM _LOG_NAME $ show frames++      resSeq <- getIncreasedResponseSequence mvarCtx+      let body   = J.StackTraceBody (reverse frames) (length frames)+          res    = J.defaultStackTraceResponse resSeq req+          resStr = J.encode $ res{J.bodyStackTraceResponse = body}+      sendResponseL resStr++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = L.intercalate " " ["stackTrace request error.", show req, show e]+      resSeq <- getIncreasedResponseSequence mvarCtx+      sendResponseL $ J.encode $ J.errorStackTraceResponse resSeq req msg +      sendErrorEvent mvarCtx msg++    createStackFrames pos = ghciProcessDebugContextData <$> (readMVar mvarCtx) >>= withProcess pos++    withProcess pos Nothing = do+      errorM _LOG_NAME "[stackTraceRequestHandler] ghci not started."+      sendErrorEvent mvarCtx "[stackTraceRequestHandler] ghci not started."+      defaultFrame pos++    withProcess pos (Just ghciProc) = G.history ghciProc outHdl >>= \case+      Left err   -> do+        errorM _LOG_NAME $ show err+        sendErrorEvent mvarCtx $ show err+        defaultFrame pos++      Right dats -> do+        cwd <- workspaceDebugContextData <$> readMVar mvarCtx+        cfs <- defaultFrame pos+        foldM (convTrace2Frame cwd) cfs dats++    convTrace2Frame cwd xs (G.StackFrame traceId funcName (G.SourcePosition file sl sc el ec)) = return $ +      J.StackFrame traceId funcName (J.Source (Just (src2mod cwd file)) file Nothing Nothing) sl sc el ec : xs++    defaultFrame (G.SourcePosition file sl sc el ec) = do+      ctx <- readMVar mvarCtx+      let cwd = workspaceDebugContextData ctx+          csf = J.StackFrame 0 "[BP]" (J.Source (Just (src2mod cwd file)) file Nothing Nothing) sl sc el ec+      return  [csf]++    outHdl msg = do+      --sendStdoutEvent mvarCtx msg+      infoM _LOG_NAME msg+++-- |+--+--+scopesRequestHandler :: MVar DebugContextData -> J.ScopesRequest -> IO ()+scopesRequestHandler mvarCtx req = flip E.catches handlers $ do+  logRequest $ show req++  let args    = J.argumentsScopesRequest req+      traceId = J.frameIdScopesArguments args++  moveFrame mvarCtx traceId++  resSeq <- getIncreasedResponseSequence mvarCtx+  let resStr = J.encode $ J.defaultScopesResponse resSeq req+  sendResponseL resStr++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = L.intercalate " " ["scopes request error.", show req, show e]+      resSeq <- getIncreasedResponseSequence mvarCtx+      sendResponseL $ J.encode $ J.errorScopesResponse resSeq req msg +      sendErrorEvent mvarCtx msg++-- |+--+--+variablesRequestHandler :: MVar DebugContextData -> J.VariablesRequest -> IO ()+variablesRequestHandler mvarCtx req = flip E.catches handlers $ do+  logRequest $ show req++  vals <- currentBindings++  resSeq <- getIncreasedResponseSequence mvarCtx+  let res = J.defaultVariablesResponse resSeq req+      resStr = J.encode $ res{J.bodyVariablesResponse = J.VariablesBody vals}+  sendResponseL resStr++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = L.intercalate " " ["variables request error.", show req, show e]+      resSeq <- getIncreasedResponseSequence mvarCtx+      sendResponseL $ J.encode $ J.errorVariablesResponse resSeq req msg +      sendErrorEvent mvarCtx msg++    currentBindings = ghciProcessDebugContextData <$> (readMVar mvarCtx) >>= withProcess++    withProcess Nothing = do+      errorM _LOG_NAME "[variablesRequestHandler] ghci not started."+      sendErrorEvent mvarCtx "[variablesRequestHandler] ghci not started."+      return []++    withProcess (Just ghciProc) = G.bindings ghciProc outHdl >>= \case+      Left err   -> do+        errorM _LOG_NAME $ show err+        sendErrorEvent mvarCtx $ show err+        return []++      Right dats -> return $ map convBind2Vals dats+    +    convBind2Vals (G.BindingData varName modName val) = J.Variable varName modName val 0++    outHdl msg = do+      --sendStdoutEvent mvarCtx msg+      infoM _LOG_NAME msg+++-- |+--+--+threadsRequestHandler :: MVar DebugContextData -> J.ThreadsRequest -> IO ()+threadsRequestHandler mvarCtx req = flip E.catches handlers $ do+  logRequest $ show req++  resSeq <- getIncreasedResponseSequence mvarCtx+  let resStr = J.encode $ J.defaultThreadsResponse resSeq req+  sendResponseL resStr++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = L.intercalate " " ["threads request error.", show req, show e]+      resSeq <- getIncreasedResponseSequence mvarCtx+      sendResponseL $ J.encode $ J.errorThreadsResponse resSeq req msg +      sendErrorEvent mvarCtx msg+++-- |+--+--+evaluateRequestHandler :: MVar DebugContextData -> J.EvaluateRequest -> IO ()+evaluateRequestHandler mvarCtx req = flip E.catches handlers $ do+  logRequest $ show req++  -- let (J.EvaluateArguments exp frameId ctx) = J.argumentsEvaluateRequest req+  -- moveFrame mvarCtx $ if isJust frameId then fromJust frameId else 0++  let (J.EvaluateArguments exp _ ctx) = J.argumentsEvaluateRequest req+  ghciProcessDebugContextData <$> (readMVar mvarCtx) >>= withProcess ctx exp++  where+    handlers = [ E.Handler someExcept ]+    someExcept (e :: E.SomeException) = do+      let msg = L.intercalate " " ["evaluate request error.", show req, show e]+      resSeq <- getIncreasedResponseSequence mvarCtx+      sendResponseL $ J.encode $ J.errorEvaluateResponse resSeq req msg +      sendErrorEvent mvarCtx msg++    withProcess _ _ Nothing = do+      errorM _LOG_NAME "[evaluateRequestHandler] ghci not started."+      sendErrorEvent mvarCtx "[evaluateRequestHandler] ghci not started."++    withProcess "watch" exp (Just ghciProc) = G.showType ghciProc outHdl exp >>= \case+      Left err -> do+        errorM _LOG_NAME $ show err+        evaluateResponse err ""++      Right typeStr -> case isFunction typeStr of +        True  -> evaluateResponse "" (getOnlyType typeStr)+        False -> G.force ghciProc outHdl exp >>= \case+          Right valStr -> evaluateResponse (getOnlyValue valStr) (getOnlyType typeStr)+          Left _ -> evaluateResponse "" (getOnlyType typeStr)++    withProcess "hover" exp (Just ghciProc) = G.showType ghciProc outHdl exp >>= \case+      Left err -> do+        errorM _LOG_NAME $ show err+        evaluateResponse err ""++      Right typeStr -> case isFunction typeStr of +        True  -> evaluateResponse (getOnlyType typeStr) (getOnlyType typeStr)+        False -> G.force ghciProc outHdl exp >>= \case+          Right valStr -> evaluateResponse ((getOnlyValue valStr) ++ " :: " ++ (getOnlyType typeStr)) (getOnlyType typeStr)+          Left _ -> evaluateResponse (getOnlyType typeStr) (getOnlyType typeStr)++    withProcess _ exp (Just ghciProc) = G.exec ghciProc outHdl exp >>= \case+      Left err   -> do+        errorM _LOG_NAME $ show err+        sendErrorEvent mvarCtx $ show err++      Right cmdStr -> do+        -- promptを消す+        let result = U.join " " . map U.strip . init . lines $ cmdStr+        evaluateResponse result ""+        sendStdoutEvent mvarCtx $ "\n" ++ G.promptGHCiProcess ghciProc++    outHdl msg = do+      --sendStdoutEvent mvarCtx msg+      infoM _LOG_NAME msg++    isFunction str = case parse isFunctionParser "isFunction" str of+      Right _ -> True+      Left _  -> False++    isFunctionParser = manyTill anyChar (string "->")++    evaluateResponse msg typeStr = do+      resSeq <- getIncreasedResponseSequence mvarCtx+      let body   = J.EvaluateBody msg typeStr 0+          res    = J.defaultEvaluateResponse resSeq req+          resStr = J.encode res{J.bodyEvaluateResponse = body}+      sendResponseL resStr++  +    -- |+    --  force結果のパーサ+    --+    --  parser of+    --    Phoityne>>= :force x+    --    x = 8+    --    Phoityne>>=+    --+    getOnlyValue :: String -> String+    getOnlyValue str = case parse getOnlyValueParser "getOnlyValue" str of+      Right vals -> vals+      Left _ -> str+      where+        getOnlyValueParser = do+          _ <- manyTill anyChar (string " = ")+          manyTill anyChar eof++    -- |+    --  type結果のパーサ+    --+    --  parser of+    --    Phoityne>>= :type x+    --    x :: Int -> Int+    --    Phoityne>>=+    --+    getOnlyType :: String -> String+    getOnlyType str = case parse getOnlyTypeParser "getOnlyType" str of+      Right vals -> vals+      Left _ -> str+      where+        getOnlyTypeParser = do+          _ <- manyTill anyChar (string " :: ")+          manyTill anyChar eof+++-- |=====================================================================+--+--  utility+++++-- |+--+--+logRequest :: String -> IO ()+logRequest reqStr = do+  let msg = L.intercalate " " ["[REQUEST]", reqStr]+  infoM _LOG_NAME msg++++-- |+--+--+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+++-- |+--+--+getIncreasedResponseSequence :: MVar DebugContextData -> IO Int+getIncreasedResponseSequence mvarCtx = do+  ctx <- takeMVar mvarCtx+  let resSec = 1 + resSeqDebugContextData ctx+  putMVar mvarCtx ctx{resSeqDebugContextData = resSec}+  return resSec+++-- |+--+--+runGHCi :: MVar DebugContextData -> String -> FilePath -> String -> IO (Either G.ErrorData G.GHCiProcess)+runGHCi mvarCtx cmdStr cwd pmt = do+  let cmdList = filter (not.null) $ U.split " " cmdStr+      cmd  = head cmdList+      opts = tail cmdList+  +  G.start outHdl cmd opts cwd pmt+  +  where+    outHdl msg = do+      sendStdoutEvent mvarCtx msg +      infoM _LOG_NAME msg+++-- |+--+--+loadHsFile :: MVar DebugContextData -> FilePath -> IO Bool+loadHsFile mvarCtx path = ghciProcessDebugContextData <$> (readMVar mvarCtx) >>= \case+  Nothing -> do+    errorM _LOG_NAME $ "load file fail.[" ++ path ++ "]" ++ " ghci not started."+    sendErrorEvent mvarCtx $ "load file fail.[" ++ path ++ "]" ++ " ghci not started."+    return False+  Just ghciProc -> G.loadFile ghciProc outHdl path >>= withFileLoadResult ghciProc+    +  where+    outHdl msg = do+      sendStdoutEvent mvarCtx msg+      infoM _LOG_NAME msg++    withFileLoadResult _ (Left err) = do+      errorM _LOG_NAME $ "load file fail.[" ++ path ++ "]" ++ " " ++ err+      sendErrorEvent mvarCtx $ "load file fail.[" ++ path ++ "]" ++ " " ++ err+      return False++    withFileLoadResult ghciProc (Right mods) = G.loadModule ghciProc outHdl mods >>= \case+      Left err -> do  +        errorM _LOG_NAME $ "load module fail. " ++ show mods ++ " " ++ err+        sendErrorEvent mvarCtx $ "load module fail. " ++ show mods ++ " " ++ err+        return False+      Right _ -> return True+++-- |+--  ブレークポイントをGHCi上でdeleteする+--+deleteBreakPointOnGHCi :: MVar DebugContextData -> BreakPointData -> IO ()+deleteBreakPointOnGHCi mvarCtx bp@(BreakPointData _ _ _ (Just breakNo) _) = +  ghciProcessDebugContextData <$> (readMVar mvarCtx) >>= \case+    Nothing -> do+      errorM _LOG_NAME $ "[deleteBreakPointOnGHCi] ghci not started. " ++ show bp+      sendErrorEvent mvarCtx $ "[deleteBreakPointOnGHCi] ghci not started. " ++ show bp+    Just ghciProc -> G.delete ghciProc outHdl breakNo >>= withResult+    +  where+    outHdl msg = do+      sendStdoutEvent mvarCtx msg+      infoM _LOG_NAME msg++    withResult (Left err) = do+      errorM _LOG_NAME $ "[deleteBreakPointOnGHCi] " ++ err ++ " " ++ show bp+      sendErrorEvent mvarCtx $ "[deleteBreakPointOnGHCi] " ++ err ++ " " ++ show bp++    withResult (Right _) = return ()++deleteBreakPointOnGHCi mvarCtx bp = do+  let err = "[deleteBreakPointOnGHCi] invalid delete break point. "  ++ show bp+  sendErrorEvent mvarCtx err+  errorM _LOG_NAME err++-- |+--  GHCi上でブレークポイントを追加する+--+addBreakPointOnGHCi :: MVar DebugContextData -> BreakPointData -> IO (Either String Int)+addBreakPointOnGHCi mvarCtx bp@(BreakPointData modName _ lineNo _ _) =+  ghciProcessDebugContextData <$> (readMVar mvarCtx) >>= \case+    Nothing -> do+      errorM _LOG_NAME $ "[addBreakPointOnGHCi] ghci not started. " ++ show bp+      return $ Left $ "[addBreakPointOnGHCi] ghci not started. " ++ show bp+    Just ghciProc -> G.setBreak ghciProc outHdl modName lineNo+  +  where+    outHdl msg = do+      sendStdoutEvent mvarCtx msg+      infoM _LOG_NAME msg++-- |+--  GHCi上で関数ブレークポイントを追加する+--+addFunctionBreakPointOnGHCi :: MVar DebugContextData -> BreakPointData -> IO (Either String (Int, G.SourcePosition))+addFunctionBreakPointOnGHCi mvarCtx bp@(BreakPointData name _ _ _ _) =+  ghciProcessDebugContextData <$> (readMVar mvarCtx) >>= \case+    Nothing -> do+      errorM _LOG_NAME $ "[addFunctionBreakPointOnGHCi] ghci not started. " ++ show bp+      return $ Left $ "[addFunctionBreakPointOnGHCi] ghci not started. " ++ show bp+    Just ghciProc -> G.setFuncBreak ghciProc outHdl name+  +  where+    outHdl msg = do+      sendStdoutEvent mvarCtx msg+      infoM _LOG_NAME msg++-- |+--  Loggerのセットアップ+-- +setupLogger :: FilePath -> Priority -> IO ()+setupLogger logFile level = do+--  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++-- |+--+-- +watch :: MVar DebugContextData -> IO ()+watch mvarCtx = do+  _ <- forkIO $ watchFiles mvarCtx+  return ()++watchFiles :: MVar DebugContextData -> IO ()+watchFiles mvarCtx = do+  FSN.withManagerConf FSN.defaultConfig{FSN.confDebounce  = FSN.Debounce 1} $ \mgr -> do++    ctx <- readMVar mvarCtx+    let dir = workspaceDebugContextData ctx+  +    infoM _LOG_NAME $ "start watch files in [" ++ dir ++ "]"+    _ <- FSN.watchTree mgr dir hsFilter action+  +    forever $ threadDelay 1000000++  return ()+  +  where+    hsFilter event = U.endswith _HS_FILE_EXT $ FSN.eventPath event++    action event = do++      ctx <- readMVar mvarCtx+      withDebugStarted event $ debugStartedDebugContextData ctx++    withDebugStarted _ True = do+      resSeq <- getIncreasedResponseSequence mvarCtx+      let terminatedEvt    = J.defaultTerminatedEvent resSeq+          terminatedEvtStr = J.encode terminatedEvt{J.bodyTerminatedEvent = J.TerminatedEventBody True}+      sendEventL terminatedEvtStr++    withDebugStarted event False = do+      ctx <- takeMVar mvarCtx+      putMVar mvarCtx ctx{modifiedDebugContextData = True}+      loadHsFile mvarCtx (FSN.eventPath event) >> return ()+++-- |+--+--+moveFrame :: MVar DebugContextData -> Int -> IO ()+moveFrame mvarCtx traceId = ghciProcessDebugContextData <$> (readMVar mvarCtx) >>= withProcess+  where+    withProcess Nothing = do+      errorM _LOG_NAME "[moveFrame] ghci not started."+      sendErrorEvent mvarCtx "[moveFrame] ghci not started."++    withProcess (Just ghciProc) = do+      ctx <- readMVar mvarCtx+      let curTraceId = currentFrameIdDebugContextData ctx+          moveCount  = curTraceId - traceId+          traceCmd   = if 0 > moveCount then G.back ghciProc outHdl+                        else G.forward ghciProc outHdl++      -- _ <- traceCmd (abs moveCount)+      mapM_ traceCmd [1..(abs moveCount)]++      ctx <- takeMVar mvarCtx+      putMVar mvarCtx ctx{currentFrameIdDebugContextData = traceId}++    outHdl msg = do+      sendStdoutEvent mvarCtx msg+      infoM _LOG_NAME msg++-- |+--+--+startDebug :: MVar DebugContextData -> IO ()+startDebug mvarCtx = do+  ctx <- readMVar mvarCtx+  let started = debugStartedDebugContextData ctx+  +  ghciProcessDebugContextData <$> (readMVar mvarCtx) >>= startDebugInternal started+++  where+    startDebugInternal _ Nothing = do+      errorM _LOG_NAME "[startDebug] ghci not started."+      sendErrorEvent mvarCtx "[startDebug] ghci not started."++    startDebugInternal True (Just ghciProc) = G.trace ghciProc outHdl >>= \case+      Left err  -> do+        infoM _LOG_NAME $ show err+        --putStrLnStdout mvarCtx $ show err++        resSeq <- getIncreasedResponseSequence mvarCtx+        let terminatedEvt    = J.defaultTerminatedEvent resSeq+            terminatedEvtStr = J.encode terminatedEvt+        sendEventL terminatedEvtStr++      Right pos -> continueWithSourcePosition mvarCtx pos++    startDebugInternal False (Just ghciProc) = do+      ctx <- readMVar mvarCtx+      withModified ghciProc $ modifiedDebugContextData ctx++    withModified _ True = do+      resSeq <- getIncreasedResponseSequence mvarCtx+      let terminatedEvt    = J.defaultTerminatedEvent resSeq+          terminatedEvtStr = J.encode terminatedEvt{J.bodyTerminatedEvent = J.TerminatedEventBody True}+      sendEventL terminatedEvtStr+  +    withModified ghciProc False = G.traceMain ghciProc outHdl >>= \case+      Left err  -> do+        infoM _LOG_NAME $ show err+        --putStrLnStdout mvarCtx $ show err++        resSeq <- getIncreasedResponseSequence mvarCtx+        let terminatedEvt    = J.defaultTerminatedEvent resSeq+            terminatedEvtStr = J.encode terminatedEvt+        sendEventL terminatedEvtStr++      Right pos -> do+        ctx <- takeMVar mvarCtx+        putMVar mvarCtx ctx{currentFrameIdDebugContextData = 0, debugStartedDebugContextData = True}+        continueWithSourcePosition mvarCtx pos++    outHdl msg = do+      sendStdoutEvent mvarCtx msg+      infoM _LOG_NAME msg+++-- |+--+--+continueWithSourcePosition :: MVar DebugContextData -> G.SourcePosition -> IO ()+continueWithSourcePosition mvarCtx pos = do+  ctx <- readMVar mvarCtx++  let bpKey = getKeyOfSourcePosition pos+      bpMap = breakPointDatasDebugContextData ctx+      funcBpMap = functionBreakPointDatasDebugContextData ctx++  case MAP.lookup bpKey bpMap of+    Nothing -> case MAP.lookup bpKey funcBpMap of+      Nothing -> do+        errorM _LOG_NAME $ "breakpoint not found." ++ show bpKey+        sendStopEvent+      Just condCmd -> continueWithCondCmd $ conditionBreakPointData condCmd+    Just condCmd -> continueWithCondCmd $ conditionBreakPointData condCmd++  where++    -- |+    --+    continueWithCondCmd Nothing = do+      infoM _LOG_NAME "no condition breakpoint"+      sendStopEvent+    continueWithCondCmd (Just condStr) = ghciProcessDebugContextData <$> (readMVar mvarCtx) >>= withProcess condStr++    withProcess _ Nothing = do+      errorM _LOG_NAME "[continueWithSourcePosition] ghci not started."+      sendErrorEvent mvarCtx "[continueWithSourcePosition] ghci not started."+    withProcess condStr (Just ghciProc) = do+      forceBindings ghciProc outHdl+      G.execBool ghciProc outHdl condStr >>= withResult++    withResult (Left err) = do+      infoM _LOG_NAME err+      continueWithCondResult True+    withResult (Right condRes) = continueWithCondResult condRes++    outHdl msg = do+      sendStdoutEvent mvarCtx msg+      infoM _LOG_NAME msg++    forceBindings ghciProc outHdl = G.bindings ghciProc outHdl >>= \case+      Left err -> do+        errorM _LOG_NAME $ "[forceBindings] " ++ err+        sendErrorEvent mvarCtx $ "[forceBindings] " ++ err+        return ()+      Right bs -> do+        mapM_ (forceBind ghciProc outHdl . G.nameBindingData) bs+        return ()++    forceBind ghciProc outHdl name = G.force ghciProc outHdl name >>= \case+      Left err -> do+        errorM _LOG_NAME $ "[forceBindings] " ++ err+        sendErrorEvent mvarCtx $ "[forceBindings] " ++ err+        return ()+      Right _ -> return ()++    -- |+    --+    continueWithCondResult False = do+      sendConsoleEvent mvarCtx "[INFO] continueed because condition False."+      startDebug mvarCtx+    continueWithCondResult True  = do+      sendConsoleEvent mvarCtx "[INFO] stopped because condition not False."+      sendStopEvent++    -- |+    --+    sendStopEvent = do+      infoM _LOG_NAME $ show pos+  +      ctx <- takeMVar mvarCtx+      putMVar mvarCtx ctx{debugStoppedPosDebugContextData = Just pos}+  +      resSeq <- getIncreasedResponseSequence mvarCtx+      let stopEvt    = J.defaultStoppedEvent resSeq+          stopEvtStr = J.encode stopEvt+      sendEvent stopEvtStr
+ app/Phoityne/VSCode/IO/Main.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE MultiWayIf          #-}++module Phoityne.VSCode.IO.Main (run) where++-- モジュール+import qualified Phoityne.VSCode.Argument as A+import qualified Phoityne.VSCode.IO.Control as CTRL++-- システム+import Data.Either.Utils+import qualified Control.Exception as E+import qualified Data.ConfigFile as C+import qualified System.Console.CmdArgs as CMD+import qualified System.Log.Logger as L+++-- |+--  アプリケーションメイン+-- +run :: IO Int+run = flip E.catches handlers $ do++  -- コマンドライン引数設定+  args <- getArgs++  -- INI設定ファイルのRead+  iniSet <- loadIniFile args++  -- ロジック実行+  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 _ = do+  let cp = forceEither $ C.readstring C.emptyCP defaultIniSetting+  return cp{ C.accessfunc = C.interpolatingAccess 5 }+++-- |+-- デフォルトINI設定+-- +defaultIniSetting :: String+defaultIniSetting = unlines [+    "[DEFAULT]"+  , "work_dir = ./"+  , ""+  , "[LOG]"+  , "file  = %(work_dir)sphoityne.log"+  , "level = WARNING"+  , ""+  , "[PHOITYNE]"+  ]+
+ app/Phoityne/VSCode/IO/Utility.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE MultiWayIf #-}++module Phoityne.VSCode.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/VSCode/TH/BreakpointJSON.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE TemplateHaskell     #-}++module Phoityne.VSCode.TH.BreakpointJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/ContinueArgumentsJSON.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.ContinueArgumentsJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/ContinueRequestJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.ContinueRequestJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/ContinueResponseJSON.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.ContinueResponseJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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" ""+++-- |+--+parceErrorContinueResponse :: Int -> String -> ContinueResponse+parceErrorContinueResponse seq msg =+  ContinueResponse seq "response" (-1) False "continue" msg++-- |+--+errorContinueResponse :: Int -> ContinueRequest -> String -> ContinueResponse+errorContinueResponse seq (ContinueRequest reqSeq _ _ _) msg =+  ContinueResponse seq "response" reqSeq False "continue" msg
+ app/Phoityne/VSCode/TH/DisconnectArgumentsJSON.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.DisconnectArgumentsJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility++-- |+--   Arguments for "disconnect" request.+--+data DisconnectArguments =+  DisconnectArguments {+    restartDisconnectArguments :: Maybe Bool+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "DisconnectArguments") } ''DisconnectArguments)
+ app/Phoityne/VSCode/TH/DisconnectRequestJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.DisconnectRequestJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/DisconnectResponseJSON.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.DisconnectResponseJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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" ""++-- |+--+parceErrorDisconnectResponse :: Int -> String -> DisconnectResponse+parceErrorDisconnectResponse seq msg =+  DisconnectResponse seq "response" (-1) False "disconnect" msg++-- |+--+errorDisconnectResponse :: Int -> DisconnectRequest -> String -> DisconnectResponse+errorDisconnectResponse seq (DisconnectRequest reqSeq _ _ _) msg =+  DisconnectResponse seq "response" reqSeq False "disconnect" msg
+ app/Phoityne/VSCode/TH/ErrorResponseBodyJSON.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.ErrorResponseBodyJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/ErrorResponseJSON.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE TemplateHaskell     #-}++module Phoityne.VSCode.TH.ErrorResponseJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/EvaluateArgumentsJSON.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.EvaluateArgumentsJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/EvaluateBodyJSON.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.EvaluateBodyJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility++-- |+--    Response to "evaluate" request. +--+data EvaluateBody =+  EvaluateBody {+    resultEvaluateBody             :: String -- The result of the evaluate.+  , typeEvaluateBody               :: String -- The optional type of the evaluate result. +  , 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/VSCode/TH/EvaluateRequestJSON.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.EvaluateRequestJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/EvaluateResponseJSON.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.EvaluateResponseJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.VSCode.TH.EvaluateBodyJSON+import Phoityne.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++-- |+--+errorEvaluateResponse :: Int -> EvaluateRequest -> String -> EvaluateResponse+errorEvaluateResponse seq (EvaluateRequest reqSeq _ _ _) msg =+  EvaluateResponse seq "response" reqSeq False "evaluate" msg defaultEvaluateBody+
+ app/Phoityne/VSCode/TH/ExceptionBreakpointsFilterJSON.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE TemplateHaskell #-}+++module Phoityne.VSCode.TH.ExceptionBreakpointsFilterJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/ExitedEventBodyJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.ExitedEventBodyJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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 :: Int -> ExitedEventBody+defaultExitedEventBody code = ExitedEventBody code+
+ app/Phoityne/VSCode/TH/ExitedEventJSON.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.ExitedEventJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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 :: Int -> Int -> ExitedEvent+defaultExitedEvent seq code = ExitedEvent seq "event" "exited" $ defaultExitedEventBody code+
+ app/Phoityne/VSCode/TH/FunctionBreakpointJSON.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE TemplateHaskell     #-}++module Phoityne.VSCode.TH.FunctionBreakpointJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility++-- |+--   Properties of a breakpoint passed to the setFunctionBreakpoints request.+--+data FunctionBreakpoint =+  FunctionBreakpoint {+    nameFunctionBreakpoint      :: String           -- The name of the function. +  , conditionFunctionBreakpoint :: Maybe String  -- An optional expression for conditional breakpoints.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "FunctionBreakpoint") } ''FunctionBreakpoint)++
+ app/Phoityne/VSCode/TH/InitializeRequestArgumentsJSON.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE TemplateHaskell #-}+++module Phoityne.VSCode.TH.InitializeRequestArgumentsJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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)++defaultInitializeRequestArguments :: InitializeRequestArguments+defaultInitializeRequestArguments = InitializeRequestArguments "" False False ""
+ app/Phoityne/VSCode/TH/InitializeRequestJSON.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE TemplateHaskell #-}++module Phoityne.VSCode.TH.InitializeRequestJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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)++defaultInitializeRequest :: InitializeRequest+defaultInitializeRequest = InitializeRequest 0 "" "" defaultInitializeRequestArguments
+ app/Phoityne/VSCode/TH/InitializeResponseCapabilitesJSON.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE TemplateHaskell #-}+++module Phoityne.VSCode.TH.InitializeResponseCapabilitesJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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.+  , supportsStepBackInitializeResponseCapabilites                 :: Bool  -- The debug adapter supports stepping back.+  , supportsSetVariableInitializeResponseCapabilites              :: Bool  -- The debug adapter supports setting a variable to a value.+  , supportsRestartFrameInitializeResponseCapabilites             :: Bool  -- The debug adapter supports restarting a frame.+  , supportsGotoTargetsRequestInitializeResponseCapabilites       :: Bool  -- The debug adapter supports the gotoTargetsRequest.+  , supportsStepInTargetsRequestInitializeResponseCapabilites     :: Bool  -- The debug adapter supports the stepInTargetsRequest. +  , supportsCompletionsRequestInitializeResponseCapabilites       :: Bool  -- The debug adapter supports the completionsRequest.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "InitializeResponseCapabilites") } ''InitializeResponseCapabilites)++-- |+--+defaultInitializeResponseCapabilites :: InitializeResponseCapabilites+defaultInitializeResponseCapabilites = InitializeResponseCapabilites False False False False [] False False False False False False+
+ app/Phoityne/VSCode/TH/InitializeResponseJSON.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE TemplateHaskell #-}+++module Phoityne.VSCode.TH.InitializeResponseJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.VSCode.TH.InitializeResponseCapabilitesJSON+import Phoityne.VSCode.TH.InitializeRequestJSON++-- |+--   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)+++-- |+--+parseErrorInitializeResponse :: Int -> String -> InitializeResponse+parseErrorInitializeResponse seq msg =+  InitializeResponse seq "response" seq False "initialize" msg defaultInitializeResponseCapabilites++-- |+--+errorInitializeResponse :: Int -> InitializeRequest -> String -> InitializeResponse+errorInitializeResponse seq (InitializeRequest reqSeq _ _ _) msg =+  InitializeResponse seq "response" reqSeq False "initialize" msg defaultInitializeResponseCapabilites+
+ app/Phoityne/VSCode/TH/InitializedEventJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.InitializedEventJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/LaunchRequestArgumentsJSON.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.LaunchRequestArgumentsJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility++-- |+--   Arguments for "launch" request.+--+data LaunchRequestArguments =+  LaunchRequestArguments {+    noDebugLaunchRequestArguments    :: Maybe Bool --  If noDebug is true the launch request should launch the program without enabling debugging.+  , nameLaunchRequestArguments       :: String     -- Phoityne specific argument. required.+  , typeLaunchRequestArguments       :: String     -- Phoityne specific argument. required.+  , requestLaunchRequestArguments    :: String     -- Phoityne specific argument. required. must be "request"+  , startupLaunchRequestArguments    :: String     -- Phoityne specific argument. required.+  , workspaceLaunchRequestArguments  :: String     -- Phoityne specific argument. required.+  , logFileLaunchRequestArguments    :: String     -- Phoityne specific argument. required.+  , logLevelLaunchRequestArguments   :: String     -- Phoityne specific argument. required.+  , ghciPromptLaunchRequestArguments :: String     -- Phoityne specific argument. required.+  , ghciCmdLaunchRequestArguments    :: String     -- Phoityne specific argument. required.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "LaunchRequestArguments") } ''LaunchRequestArguments)+
+ app/Phoityne/VSCode/TH/LaunchRequestJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.LaunchRequestJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/LaunchResponseJSON.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.LaunchResponseJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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" ""++-- |+--+parceErrorLaunchResponse :: Int -> String -> LaunchResponse+parceErrorLaunchResponse seq msg =+  LaunchResponse seq "response" seq False "launch" msg++-- |+--+errorLaunchResponse :: Int -> LaunchRequest -> String -> LaunchResponse+errorLaunchResponse seq (LaunchRequest reqSeq _ _ _) msg =+  LaunchResponse seq "response" reqSeq False "launch" msg+++
+ app/Phoityne/VSCode/TH/MessageJSON.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.MessageJSON where++import Data.Aeson.TH+import qualified Data.Map as MAP++import Phoityne.VSCode.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/VSCode/TH/NextArgumentsJSON.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.NextArgumentsJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/NextRequestJSON.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.NextRequestJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/NextResponseJSON.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.NextResponseJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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" ""+++-- |+--+errorNextResponse :: Int -> NextRequest -> String -> NextResponse+errorNextResponse seq (NextRequest reqSeq _ _ _) msg =+  NextResponse seq "response" reqSeq False "next" msg+++
+ app/Phoityne/VSCode/TH/OutputEventBodyJSON.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.OutputEventBodyJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/OutputEventJSON.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE TemplateHaskell     #-}++module Phoityne.VSCode.TH.OutputEventJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/PauseArgumentsJSON.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.PauseArgumentsJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/PauseRequestJSON.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.PauseRequestJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/PauseResponseJSON.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.PauseResponseJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/RequestJSON.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE TemplateHaskell #-}++module Phoityne.VSCode.TH.RequestJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/ScopeJSON.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.ScopeJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/ScopesArgumentsJSON.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.ScopesArgumentsJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/ScopesBodyJSON.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.ScopesBodyJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/ScopesRequestJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.ScopesRequestJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/ScopesResponseJSON.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.ScopesResponseJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.VSCode.TH.ScopesBodyJSON+import Phoityne.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+++-- |+--+errorScopesResponse :: Int -> ScopesRequest -> String -> ScopesResponse+errorScopesResponse seq (ScopesRequest reqSeq _ _ _) msg =+  ScopesResponse seq "response" reqSeq False "scopes" msg defaultScopesBody+
+ app/Phoityne/VSCode/TH/SetBreakpointsRequestArgumentsJSON.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.SetBreakpointsRequestArgumentsJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.VSCode.TH.SourceJSON+import Phoityne.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.+  --, sourceModifiedSetBreakpointsRequestArguments :: Bool                -- A value of true indicates that the underlying source has been modified which results in new breakpoint locations.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "SetBreakpointsRequestArguments") } ''SetBreakpointsRequestArguments)+
+ app/Phoityne/VSCode/TH/SetBreakpointsRequestJSON.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.SetBreakpointsRequestJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/SetBreakpointsResponseBodyJSON.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.SetBreakpointsResponseBodyJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/SetBreakpointsResponseJSON.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.SetBreakpointsResponseJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.VSCode.TH.SetBreakpointsRequestJSON+import Phoityne.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+++-- |+--+errorSetBreakpointsResponse :: Int -> SetBreakpointsRequest -> String -> SetBreakpointsResponse+errorSetBreakpointsResponse seq (SetBreakpointsRequest reqSeq _ _ _) msg =+  SetBreakpointsResponse seq "response" reqSeq False "setBreakpoints" msg defaultSetBreakpointsResponseBody+
+ app/Phoityne/VSCode/TH/SetFunctionBreakpointsRequestArgumentsJSON.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.SetFunctionBreakpointsRequestArgumentsJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.VSCode.TH.FunctionBreakpointJSON++-- |+--   Arguments for "setFunctionBreakpoints" request.+--+data SetFunctionBreakpointsRequestArguments =+  SetFunctionBreakpointsRequestArguments {+    breakpointsSetFunctionBreakpointsRequestArguments    :: [FunctionBreakpoint]  -- The function names of the breakpoints.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "SetFunctionBreakpointsRequestArguments") } ''SetFunctionBreakpointsRequestArguments)+
+ app/Phoityne/VSCode/TH/SetFunctionBreakpointsRequestJSON.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.SetFunctionBreakpointsRequestJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.VSCode.TH.SetFunctionBreakpointsRequestArgumentsJSON++-- |+--   SetFunctionBreakpoints request; value of command field is "setFunctionBreakpoints".+--   Sets multiple function breakpoints and clears all previous function breakpoints.+--   To clear all function breakpoint, specify an empty array.+--   When a function breakpoint is hit, a StoppedEvent (event type 'function breakpoint') is generated.+--+data SetFunctionBreakpointsRequest =+  SetFunctionBreakpointsRequest {+    seqSetFunctionBreakpointsRequest       :: Int                                    -- Sequence number+  , typeSetFunctionBreakpointsRequest      :: String                                 -- One of "request", "response", or "event"+  , commandSetFunctionBreakpointsRequest   :: String                                 -- The command to execute+  , argumentsSetFunctionBreakpointsRequest :: SetFunctionBreakpointsRequestArguments -- Arguments for "setFunctionBreakpoints" request.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "SetFunctionBreakpointsRequest") } ''SetFunctionBreakpointsRequest)
+ app/Phoityne/VSCode/TH/SetFunctionBreakpointsResponseBodyJSON.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE TemplateHaskell #-}+++module Phoityne.VSCode.TH.SetFunctionBreakpointsResponseBodyJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.VSCode.TH.BreakpointJSON++-- |+--+--+data SetFunctionBreakpointsResponseBody =+  SetFunctionBreakpointsResponseBody {+    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 SetFunctionBreakpointsArguments.+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "SetFunctionBreakpointsResponseBody") } ''SetFunctionBreakpointsResponseBody)++-- |+--+defaultSetFunctionBreakpointsResponseBody :: SetFunctionBreakpointsResponseBody+defaultSetFunctionBreakpointsResponseBody = SetFunctionBreakpointsResponseBody []++++
+ app/Phoityne/VSCode/TH/SetFunctionBreakpointsResponseJSON.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.SetFunctionBreakpointsResponseJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.VSCode.TH.SetFunctionBreakpointsRequestJSON+import Phoityne.VSCode.TH.SetFunctionBreakpointsResponseBodyJSON++-- |+--   Response to "setFunctionBreakpoints" request.+--+data SetFunctionBreakpointsResponse =+  SetFunctionBreakpointsResponse {+    seqSetFunctionBreakpointsResponse         :: Int     -- Sequence number+  , typeSetFunctionBreakpointsResponse        :: String  -- One of "request", "response", or "event"+  , request_seqSetFunctionBreakpointsResponse :: Int     -- Sequence number of the corresponding request+  , successSetFunctionBreakpointsResponse     :: Bool    -- Outcome of the request+  , commandSetFunctionBreakpointsResponse     :: String  -- The command requested +  , messageSetFunctionBreakpointsResponse     :: String  -- Contains error message if success == false.+  , bodySetFunctionBreakpointsResponse        :: SetFunctionBreakpointsResponseBody+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "SetFunctionBreakpointsResponse") } ''SetFunctionBreakpointsResponse)+++-- |+--+defaultSetFunctionBreakpointsResponse :: Int -> SetFunctionBreakpointsRequest ->  SetFunctionBreakpointsResponse+defaultSetFunctionBreakpointsResponse seq (SetFunctionBreakpointsRequest reqSeq _ _ _) =+  SetFunctionBreakpointsResponse seq "response" reqSeq True "setBreakpoints" "" defaultSetFunctionBreakpointsResponseBody+++-- |+--+errorSetFunctionBreakpointsResponse :: Int -> SetFunctionBreakpointsRequest -> String -> SetFunctionBreakpointsResponse+errorSetFunctionBreakpointsResponse seq (SetFunctionBreakpointsRequest reqSeq _ _ _) msg =+  SetFunctionBreakpointsResponse seq "response" reqSeq False "setBreakpoints" msg defaultSetFunctionBreakpointsResponseBody+
+ app/Phoityne/VSCode/TH/SourceArgumentsJSON.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.SourceArgumentsJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/SourceBreakpointJSON.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE TemplateHaskell     #-}++module Phoityne.VSCode.TH.SourceBreakpointJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/SourceJSON.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.SourceJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/SourceRequestJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.SourceRequestJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/SourceResponseBodyJSON.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.SourceResponseBodyJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/SourceResponseJSON.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.SourceResponseJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.VSCode.TH.SourceResponseBodyJSON+import Phoityne.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/VSCode/TH/StackFrameJSON.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.StackFrameJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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.+  , endLineStackFrame   :: Int  -- An optional end line of the range covered by the stack frame.+  , endColumnStackFrame :: Int  -- An optional end column of the range covered by the stack frame.+  } deriving (Show, Read, Eq)+++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length "StackFrame") } ''StackFrame)
+ app/Phoityne/VSCode/TH/StackTraceArgumentsJSON.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.StackTraceArgumentsJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/StackTraceBodyJSON.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.StackTraceBodyJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/StackTraceRequestJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.StackTraceRequestJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/StackTraceResponseJSON.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.StackTraceResponseJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.VSCode.TH.StackTraceBodyJSON+import Phoityne.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+++-- |+--+errorStackTraceResponse :: Int -> StackTraceRequest -> String -> StackTraceResponse+errorStackTraceResponse seq (StackTraceRequest reqSeq _ _ _) msg =+  StackTraceResponse seq "response" reqSeq False "stackTrace" msg defaultStackTraceBody+
+ app/Phoityne/VSCode/TH/StepInArgumentsJSON.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.StepInArgumentsJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/StepInRequestJSON.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.StepInRequestJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/StepInResponseJSON.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.StepInResponseJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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" ""+++-- |+--+errorStepInResponse :: Int -> StepInRequest -> String -> StepInResponse+errorStepInResponse seq (StepInRequest reqSeq _ _ _) msg =+  StepInResponse seq "response" reqSeq False "stepIn" msg+
+ app/Phoityne/VSCode/TH/StepOutArgumentsJSON.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.StepOutArgumentsJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/StepOutRequestJSON.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.StepOutRequestJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/StepOutResponseJSON.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.StepOutResponseJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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" ""+++-- |+--+errorStepOutResponse :: Int -> StepOutRequest -> String -> StepOutResponse+errorStepOutResponse seq (StepOutRequest reqSeq _ _ _) msg =+  StepOutResponse seq "response" reqSeq False "stepOut" msg++
+ app/Phoityne/VSCode/TH/StoppedEventBodyJSON.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.StoppedEventBodyJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/StoppedEventJSON.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.StoppedEventJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/TerminatedEventBodyJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.TerminatedEventBodyJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/TerminatedEventJSON.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.TerminatedEventJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/ThreadJSON.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.ThreadJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/ThreadsRequestJSON.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.ThreadsRequestJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/ThreadsResponseBodyJSON.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.ThreadsResponseBodyJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/ThreadsResponseJSON.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.ThreadsResponseJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.VSCode.TH.ThreadsResponseBodyJSON+import Phoityne.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+++-- |+--+errorThreadsResponse :: Int -> ThreadsRequest -> String -> ThreadsResponse+errorThreadsResponse seq (ThreadsRequest reqSeq _ _) msg =+  ThreadsResponse seq "response" reqSeq False "threads" msg defaultThreadsResponseBody+
+ app/Phoityne/VSCode/TH/VariableJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.VariableJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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+  , typeVariable               :: String  -- he variable's type.+  , valueVariable              :: String  -- The variable's value. For structured objects this can be a multi line text, e.g. for a function the body of a function.+  , 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/VSCode/TH/VariablesArgumentsJSON.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.VariablesArgumentsJSON where++import Data.Aeson.TH++import Phoityne.VSCode.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/VSCode/TH/VariablesBodyJSON.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.VariablesBodyJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/VariablesRequestJSON.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.VariablesRequestJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.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/VSCode/TH/VariablesResponseJSON.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE TemplateHaskell     #-}+++module Phoityne.VSCode.TH.VariablesResponseJSON where++import Data.Aeson.TH++import Phoityne.VSCode.Utility+import Phoityne.VSCode.TH.VariablesBodyJSON+import Phoityne.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++-- |+--+errorVariablesResponse :: Int -> VariablesRequest -> String -> VariablesResponse+errorVariablesResponse seq (VariablesRequest reqSeq _ _ _) msg =+  VariablesResponse seq "response" reqSeq False "variables" msg defaultVariablesBody++
+ app/Phoityne/VSCode/Utility.hs view
@@ -0,0 +1,74 @@++module Phoityne.VSCode.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
@@ -1,5 +1,5 @@ name:                phoityne-vscode-version:             0.0.7.0+version:             0.0.8.0 synopsis:            ghci debug viewer on Visual Studio Code description:         Please see README.md license:             BSD3@@ -19,87 +19,94 @@   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+                     , Phoityne.VSCode.Argument+                     , Phoityne.VSCode.IO.Control+                     , Phoityne.VSCode.IO.Main+                     , Phoityne.VSCode.IO.Core+                     , Phoityne.VSCode.Constant+                     , Phoityne.VSCode.Utility+                     , Phoityne.VSCode.IO.Utility+                     , Phoityne.VSCode.TH.BreakpointJSON+                     , Phoityne.VSCode.TH.ContinueArgumentsJSON+                     , Phoityne.VSCode.TH.ContinueRequestJSON+                     , Phoityne.VSCode.TH.ContinueResponseJSON+                     , Phoityne.VSCode.TH.DisconnectArgumentsJSON+                     , Phoityne.VSCode.TH.DisconnectRequestJSON+                     , Phoityne.VSCode.TH.DisconnectResponseJSON+                     , Phoityne.VSCode.TH.ErrorResponseBodyJSON+                     , Phoityne.VSCode.TH.ErrorResponseJSON+                     , Phoityne.VSCode.TH.EvaluateArgumentsJSON+                     , Phoityne.VSCode.TH.EvaluateBodyJSON+                     , Phoityne.VSCode.TH.EvaluateRequestJSON+                     , Phoityne.VSCode.TH.EvaluateResponseJSON+                     , Phoityne.VSCode.TH.ExceptionBreakpointsFilterJSON+                     , Phoityne.VSCode.TH.ExitedEventBodyJSON+                     , Phoityne.VSCode.TH.ExitedEventJSON+                     , Phoityne.VSCode.TH.FunctionBreakpointJSON+                     , Phoityne.VSCode.TH.InitializedEventJSON+                     , Phoityne.VSCode.TH.InitializeRequestArgumentsJSON+                     , Phoityne.VSCode.TH.InitializeRequestJSON+                     , Phoityne.VSCode.TH.InitializeResponseCapabilitesJSON+                     , Phoityne.VSCode.TH.InitializeResponseJSON+                     , Phoityne.VSCode.TH.LaunchRequestArgumentsJSON+                     , Phoityne.VSCode.TH.LaunchRequestJSON+                     , Phoityne.VSCode.TH.LaunchResponseJSON+                     , Phoityne.VSCode.TH.MessageJSON+                     , Phoityne.VSCode.TH.NextArgumentsJSON+                     , Phoityne.VSCode.TH.NextRequestJSON+                     , Phoityne.VSCode.TH.NextResponseJSON+                     , Phoityne.VSCode.TH.OutputEventJSON+                     , Phoityne.VSCode.TH.OutputEventBodyJSON+                     , Phoityne.VSCode.TH.PauseArgumentsJSON+                     , Phoityne.VSCode.TH.PauseRequestJSON+                     , Phoityne.VSCode.TH.PauseResponseJSON+                     , Phoityne.VSCode.TH.RequestJSON+                     , Phoityne.VSCode.TH.ScopeJSON+                     , Phoityne.VSCode.TH.ScopesArgumentsJSON+                     , Phoityne.VSCode.TH.ScopesBodyJSON+                     , Phoityne.VSCode.TH.ScopesRequestJSON+                     , Phoityne.VSCode.TH.ScopesResponseJSON+                     , Phoityne.VSCode.TH.SetBreakpointsRequestArgumentsJSON+                     , Phoityne.VSCode.TH.SetBreakpointsRequestJSON+                     , Phoityne.VSCode.TH.SetBreakpointsResponseBodyJSON+                     , Phoityne.VSCode.TH.SetBreakpointsResponseJSON+                     , Phoityne.VSCode.TH.SetFunctionBreakpointsRequestArgumentsJSON+                     , Phoityne.VSCode.TH.SetFunctionBreakpointsRequestJSON+                     , Phoityne.VSCode.TH.SetFunctionBreakpointsResponseBodyJSON+                     , Phoityne.VSCode.TH.SetFunctionBreakpointsResponseJSON+                     , Phoityne.VSCode.TH.SourceArgumentsJSON+                     , Phoityne.VSCode.TH.SourceBreakpointJSON+                     , Phoityne.VSCode.TH.SourceJSON+                     , Phoityne.VSCode.TH.SourceRequestJSON+                     , Phoityne.VSCode.TH.SourceResponseBodyJSON+                     , Phoityne.VSCode.TH.SourceResponseJSON+                     , Phoityne.VSCode.TH.StackFrameJSON+                     , Phoityne.VSCode.TH.StackTraceArgumentsJSON+                     , Phoityne.VSCode.TH.StackTraceBodyJSON+                     , Phoityne.VSCode.TH.StackTraceRequestJSON+                     , Phoityne.VSCode.TH.StackTraceResponseJSON+                     , Phoityne.VSCode.TH.StepInArgumentsJSON+                     , Phoityne.VSCode.TH.StepInRequestJSON+                     , Phoityne.VSCode.TH.StepInResponseJSON+                     , Phoityne.VSCode.TH.StepOutArgumentsJSON+                     , Phoityne.VSCode.TH.StepOutRequestJSON+                     , Phoityne.VSCode.TH.StepOutResponseJSON+                     , Phoityne.VSCode.TH.StoppedEventBodyJSON+                     , Phoityne.VSCode.TH.StoppedEventJSON+                     , Phoityne.VSCode.TH.TerminatedEventBodyJSON+                     , Phoityne.VSCode.TH.TerminatedEventJSON+                     , Phoityne.VSCode.TH.ThreadJSON+                     , Phoityne.VSCode.TH.ThreadsRequestJSON+                     , Phoityne.VSCode.TH.ThreadsResponseBodyJSON+                     , Phoityne.VSCode.TH.ThreadsResponseJSON+                     , Phoityne.VSCode.TH.VariableJSON+                     , Phoityne.VSCode.TH.VariablesArgumentsJSON+                     , Phoityne.VSCode.TH.VariablesBodyJSON+                     , Phoityne.VSCode.TH.VariablesRequestJSON+                     , Phoityne.VSCode.TH.VariablesResponseJSON+                     , Phoityne.GHCi+                     , Phoityne.GHCi.IO.Command+                     , Phoityne.GHCi.IO.Process   build-depends:       base >= 4.7 && < 5                      , directory                      , Cabal@@ -125,15 +132,4 @@                      , split                      , fsnotify   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 
@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}