haskell-debug-adapter 0.0.31.0 → 0.0.32.0

raw patch · 23 files changed

+360/−444 lines, 23 filesdep +ghci-dapdep −MissingHdep ~haskell-dap

Dependencies added: ghci-dap

Dependencies removed: MissingH

Dependency ranges changed: haskell-dap

Files

Changelog.md +4/−0
README.md +25/−21
haskell-debug-adapter.cabal +13/−13
src/Haskell/Debug/Adapter/GHCi.hs +53/−102
src/Haskell/Debug/Adapter/State/Contaminated.hs +36/−36
src/Haskell/Debug/Adapter/State/DebugRun.hs +33/−44
src/Haskell/Debug/Adapter/State/DebugRun/Continue.hs +4/−11
src/Haskell/Debug/Adapter/State/DebugRun/InternalTerminate.hs +1/−1
src/Haskell/Debug/Adapter/State/DebugRun/Next.hs +4/−11
src/Haskell/Debug/Adapter/State/DebugRun/Scopes.hs +4/−11
src/Haskell/Debug/Adapter/State/DebugRun/StackTrace.hs +4/−12
src/Haskell/Debug/Adapter/State/DebugRun/StepIn.hs +4/−12
src/Haskell/Debug/Adapter/State/DebugRun/Terminate.hs +1/−1
src/Haskell/Debug/Adapter/State/DebugRun/Threads.hs +1/−1
src/Haskell/Debug/Adapter/State/DebugRun/Variables.hs +4/−11
src/Haskell/Debug/Adapter/State/GHCiRun.hs +36/−36
src/Haskell/Debug/Adapter/State/GHCiRun/ConfigurationDone.hs +1/−1
src/Haskell/Debug/Adapter/State/Init.hs +21/−21
src/Haskell/Debug/Adapter/State/Init/Initialize.hs +1/−1
src/Haskell/Debug/Adapter/State/Init/Launch.hs +29/−30
src/Haskell/Debug/Adapter/State/Utility.hs +22/−40
src/Haskell/Debug/Adapter/Type.hs +3/−3
src/Haskell/Debug/Adapter/Utility.hs +56/−25

Changelog.md view

@@ -1,3 +1,7 @@+20200105 haskell-debug-adapter-0.0.32.0+  * [INFO] support haskell-dap-0.0.14.0.+  * [INFO] support ghci-dap-0.0.13.0.+  20190505 haskell-debug-adapter-0.0.31.0   * [MODIFY] refactor some types.

README.md view

@@ -1,17 +1,39 @@ -# HDA : Haskell Debug Adapter+# Haskell Debug Adapter  A [debug adapter](https://microsoft.github.io/debug-adapter-protocol/) for Haskell debugging system.  ![101_deploy.png](https://raw.githubusercontent.com/phoityne/haskell-debug-adapter/master/docs/design/101_deploy.png) -Started developing based on [phoityne-vscode-0.0.28.0](https://hackage.haskell.org/package/phoityne-vscode).  +Started development based on [phoityne-vscode-0.0.28.0](https://hackage.haskell.org/package/phoityne-vscode).   Changed package name (because a name "phoityne-vscode" is ambiguous.), and with some refactoring. +* Haskell Debugger+  * haskell-debug-adapter  +    This library.+  * [haskell-dap](https://github.com/phoityne/haskell-dap)  +    Haskell implementation of DAP interface data.+  * [ghci-dap](https://github.com/phoityne/ghci-dap)  +    A GHCi having DAP interface.++* Debug adapter clients+  * [phoityne-vscode](https://marketplace.visualstudio.com/items?itemName=phoityne.phoityne-vscode)([hdx4vsc](https://github.com/phoityne/hdx4vsc))  +    An extension for VSCode.+  * [hdx4vim](https://github.com/phoityne/hdx4vim)  +    This is just a configuration for the [vimspector](https://github.com/puremourning/vimspector) which is a debug adapter client of Vim.   +  See a sample configuration.+  * [hdx4emacs](https://github.com/phoityne/hdx4emacs)  +    This is just a configuration for dap-mode of Emacs.  +    See a sample configuration.+  * [hdx4vs](https://github.com/phoityne/hdx4vs)  +    An extension for Visual Studio.+ # Requirement   - haskell-dap   - ghci-dap +Install these libraries at once.+ ``` > stack install haskell-dap ghci-dap haskell-debug-adapter ```@@ -20,26 +42,8 @@ # Limitation Currently this project is an __experimental__ design and implementation. -* Dev and checked on windows10 ghc-8.4+* Developed and tested on windows10 ghc-8.6 * The source file extension must be ".hs" * Can not use STDIN handle while debugging. ---# Configuration--## launch.json--|NAME|REQUIRED OR OPTIONAL|DEFAULT SETTING|DESCRIPTION|-|:--|:--:|:--|:--|-|startup|required|${workspaceRoot}/test/Spec.hs|debug startup file, will be loaded automatically.|-|startupFunc|optional|"" (empty string)|debug startup function, will be run instead of main function.|-|startupArgs|optional|"" (empty string)|arguments for startup function. set as string type.|-|ghciCmd|required|stack ghci __--with-ghc=ghci-dap__ --test --no-load --no-build --main-is TARGET --ghci-options -fprint-evld-with-show|launch ghci command, must be Prelude module loaded. For example, "ghci -i${workspaceRoot}/src", "cabal exec -- ghci -i${workspaceRoot}/src"|-|ghciPrompt|required|H>>=|ghci command prompt string.|-|ghciInitialPrompt|optional|"Prelude> "|initial pormpt of ghci. set it when using custom prompt. e.g. set in .ghci|-|stopOnEntry|required|false|stop or not after debugger launched.-|mainArgs|optional|"" (empty string)|main arguments.|-|logFile|required|${workspaceRoot}/.vscode/phoityne.log|internal log file.|-|logLevel|required|WARNING|internal log level.|

haskell-debug-adapter.cabal view

@@ -1,13 +1,13 @@ cabal-version: 1.12
 --- This file has been generated from package.yaml by hpack version 0.31.1.+-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack ----- hash: bdbb77dee4fb24c9ebba6688c717b597fe7f4a5777a04bae83277c3c8361e821+-- hash: 68d1bb0d01048b286f46f92073a82bbfcd7882495077f4853d74f88246cdf8c2  name:           haskell-debug-adapter-version:        0.0.31.0+version:        0.0.32.0 synopsis:       Haskell Debug Adapter. description:    Please see README.md category:       Development@@ -15,7 +15,7 @@ bug-reports:    https://github.com/phoityne/haskell-debug-adapter/issues author:         phoityne_hs maintainer:     phoityne.hs@gmail.com-copyright:      2016-2019 phoityne_hs+copyright:      2016-2020 phoityne_hs license:        BSD3 license-file:   LICENSE build-type:     Simple@@ -59,11 +59,10 @@       Paths_haskell_debug_adapter   hs-source-dirs:       src-  default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedLabels PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns+  default-extensions: BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedLabels PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns   ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-orphans -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints   build-depends:       Cabal-    , MissingH     , aeson     , async     , base >=4.7 && <5@@ -77,7 +76,8 @@     , directory     , filepath     , fsnotify-    , haskell-dap >=0.0.12.0+    , ghci-dap >=0.0.13.0+    , haskell-dap >=0.0.14.0     , hslogger     , lens     , mtl@@ -98,11 +98,10 @@       Paths_haskell_debug_adapter   hs-source-dirs:       app-  default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedLabels PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns+  default-extensions: BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedLabels PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns   ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-orphans -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N   build-depends:       Cabal-    , MissingH     , aeson     , async     , base >=4.7 && <5@@ -116,7 +115,8 @@     , directory     , filepath     , fsnotify-    , haskell-dap >=0.0.12.0+    , ghci-dap >=0.0.13.0+    , haskell-dap >=0.0.14.0     , haskell-debug-adapter     , hslogger     , lens@@ -139,11 +139,10 @@       Paths_haskell_debug_adapter   hs-source-dirs:       test-  default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedLabels PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns+  default-extensions: BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedLabels PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns   ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-orphans -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N   build-depends:       Cabal-    , MissingH     , aeson     , async     , base >=4.7 && <5@@ -157,7 +156,8 @@     , directory     , filepath     , fsnotify-    , haskell-dap >=0.0.12.0+    , ghci-dap >=0.0.13.0+    , haskell-dap >=0.0.14.0     , haskell-debug-adapter     , hslogger     , hspec

src/Haskell/Debug/Adapter/GHCi.hs view

@@ -15,7 +15,6 @@ import qualified System.Environment as S import qualified Data.Map as M import qualified Data.List as L-import qualified Data.String.Utils as U  import Haskell.Debug.Adapter.Type import qualified Haskell.Debug.Adapter.Utility as U@@ -30,7 +29,7 @@           -> FilePath           -> M.Map String String           -> AppContext ()-startGHCi cmd opts cwd envs = +startGHCi cmd opts cwd envs =   U.liftIOE (startGHCiIO cmd opts cwd envs) >>= liftEither >>= updateGHCi    where@@ -85,143 +84,95 @@    where     -- |-    -- +    --     getReadHandleEncoding :: IO TextEncoding     getReadHandleEncoding = if       | Windows == buildOS -> mkTextEncoding "CP932//TRANSLIT"       | otherwise -> mkTextEncoding "UTF-8//TRANSLIT"      -- |-    -- +    --     getRunEnv       | null envs = return Nothing       | otherwise = do           curEnvs <- S.getEnvironment-          return $ Just $ M.toList envs ++ curEnvs +          return $ Just $ M.toList envs ++ curEnvs   -- |----type ExpectCallBack = Bool -> [String] -> [String] -> AppContext ()---- |---   expect prompt or eof--- -expectEOF :: ExpectCallBack -> AppContext [String]-expectEOF func = expectH' True func---- |---   expect prompt. eof throwError.+--  write to ghci. ---expectH :: ExpectCallBack -> AppContext [String]-expectH func = expectH' False func+command :: String -> AppContext ()+command cmd = do+  mver <- view ghciProcAppStores <$> get+  proc <- U.liftIOE $ readMVar mver+  let hdl = proc^.wHdLGHCiProc --- |----expectH' :: Bool -> ExpectCallBack -> AppContext [String]-expectH' tilEOF func = do-  pmpt <- view ghciPmptAppStores <$> get-  mvar <- view ghciProcAppStores <$> get-  proc <- liftIO $ readMVar mvar-  let hdl = proc^.rHdlGHCiProc-      plen = length pmpt+  U.liftIOE $ S.hPutStrLn hdl cmd+  pout cmd -  go tilEOF plen hdl []-     where-    go False plen hdl acc = U.readLine hdl >>= go' plen hdl acc-    go True plen hdl acc = liftIO (S.hIsEOF hdl) >>= \case-      False -> U.readLine hdl >>= go' plen hdl acc-      True  -> return acc--    go' plen hdl acc b = do-      let newL = U.rstrip b-      if L.isSuffixOf _DAP_CMD_END2 newL-        then goEnd plen hdl acc-        else cont plen hdl acc newL--    cont plen hdl acc newL = do-      let newAcc = acc ++ [newL]-      func False newAcc [newL]-      go tilEOF plen hdl newAcc--    goEnd plen hdl acc = do-      b <- liftIO $ B.hGet hdl plen-      let l = U.bs2str b-          newAcc = acc ++ [l]--      func True newAcc [l]-      return newAcc+    pout s+      | L.isPrefixOf ":dap-" s = U.sendStdoutEventLF $ (takeWhile ((/=) ' ') s) ++ " ..."+      | otherwise = U.sendStdoutEventLF s   -- | ---expect :: String -> ExpectCallBack -> AppContext ()-expect key func = do+expectInitPmpt :: String -> AppContext [String]+expectInitPmpt pmpt = do   mvar <- view ghciProcAppStores <$> get-  proc <- liftIO $ readMVar mvar+  proc <- U.liftIOE $ readMVar mvar   let hdl = proc^.rHdlGHCiProc -  xs <- go key hdl ""-  let strs = map U.rstrip $ lines xs+  xs <- go pmpt hdl "" -  func True strs strs+  let strs = map U.rstrip $ lines xs+  pout strs+  return strs    where-    go kb hdl acc = U.readChar hdl-      >>= go' kb hdl acc+    go key hdl acc = U.readChar hdl+                >>= byPmpt key hdl acc -    go' kb hdl acc b = do+    byPmpt key hdl acc b = do       let newAcc = acc ++ b-      if L.isSuffixOf kb newAcc+      if L.isSuffixOf key newAcc         then return newAcc-        else go kb hdl newAcc+        else go key hdl newAcc +    pout [] = return ()+    pout (x:[]) = U.sendStdoutEvent x+    pout (x:xs) = U.sendStdoutEventLF x >> pout xs  -- |---  write to ghci. ---command :: String -> AppContext ()-command cmd = do-  mver <- view ghciProcAppStores <$> get-  proc <- liftIO $ readMVar mver-  let hdl = proc^.wHdLGHCiProc+expectPmpt :: AppContext [String]+expectPmpt = do+  pmpt <- view ghciPmptAppStores <$> get+  mvar <- view ghciProcAppStores <$> get+  proc <- U.liftIOE $ readMVar mvar+  let hdl = proc^.rHdlGHCiProc+      plen = length pmpt -  U.liftIOE (Right <$> S.hPutStrLn hdl cmd) >>= liftEither+  go plen hdl [] +  where+    go plen hdl acc = U.liftIOE (S.hIsEOF hdl) >>= \case+      True  -> return acc+      False -> U.readLine hdl >>= byLine plen hdl acc --- |---  write to ghci.----stdoutCallBk :: Bool -> [String] -> [String] -> AppContext ()-stdoutCallBk _ _ ([]) = return ()-stdoutCallBk True  _ (x:[]) = U.sendStdoutEvent x-stdoutCallBk False _ (x:[]) = U.sendStdoutEventLF x-stdoutCallBk True  _ xs = do-  mapM_ U.sendStdoutEventLF $ init xs-  U.sendStdoutEvent $ last xs-stdoutCallBk False _ xs = mapM_ U.sendStdoutEventLF xs+    byLine plen hdl acc line+      | L.isSuffixOf _DAP_CMD_END2 line = goEnd plen hdl acc+      | otherwise = cont plen hdl acc line +    cont plen hdl acc l = do+      when (not (U.startswith _DAP_HEADER l)) $ U.sendStdoutEventLF l+      go plen hdl $ acc ++ [l] --- |----cmdAndOut :: String -> AppContext ()-cmdAndOut cmd = do-  pout cmd-  command cmd-  where-    pout s-      | L.isPrefixOf ":dap-" s = U.sendStdoutEventLF $ (takeWhile ((/=) ' ') s) ++ " ..."-      | otherwise = U.sendStdoutEventLF s-      +    goEnd plen hdl acc = do+      b <- U.liftIOE $ B.hGet hdl plen+      let l = U.bs2str b+      U.sendStdoutEvent l+      return $ acc ++ [l] --- |---  write to ghci.----funcCallBk :: (Bool -> String -> AppContext ()) -> Bool -> [String] -> [String] -> AppContext ()-funcCallBk _ _ _ ([]) = return ()-funcCallBk f b _ (x:[]) = f b x-funcCallBk f True  _ xs = do-  mapM_ (f False) $ init xs-  f True $ last xs-funcCallBk f False _ xs = mapM_ (f False) xs

src/Haskell/Debug/Adapter/State/Contaminated.hs view

@@ -34,27 +34,27 @@    -- |   ---  doActivity s (WrapRequest r@InitializeRequest{})              = action2 s r-  doActivity s (WrapRequest r@LaunchRequest{})                  = action2 s r-  doActivity s (WrapRequest r@DisconnectRequest{})              = action2 s r-  doActivity s (WrapRequest r@PauseRequest{})                   = action2 s r-  doActivity s (WrapRequest r@TerminateRequest{})               = action2 s r-  doActivity s (WrapRequest r@SetBreakpointsRequest{})          = action2 s r-  doActivity s (WrapRequest r@SetFunctionBreakpointsRequest{})  = action2 s r-  doActivity s (WrapRequest r@SetExceptionBreakpointsRequest{}) = action2 s r-  doActivity s (WrapRequest r@ConfigurationDoneRequest{})       = action2 s r-  doActivity s (WrapRequest r@ThreadsRequest{})                 = action2 s r-  doActivity s (WrapRequest r@StackTraceRequest{})              = action2 s r-  doActivity s (WrapRequest r@ScopesRequest{})                  = action2 s r-  doActivity s (WrapRequest r@VariablesRequest{})               = action2 s r-  doActivity s (WrapRequest r@ContinueRequest{})                = action2 s r-  doActivity s (WrapRequest r@NextRequest{})                    = action2 s r-  doActivity s (WrapRequest r@StepInRequest{})                  = action2 s r-  doActivity s (WrapRequest r@EvaluateRequest{})                = action2 s r-  doActivity s (WrapRequest r@CompletionsRequest{})             = action2 s r-  doActivity s (WrapRequest r@InternalTransitRequest{})         = action2 s r-  doActivity s (WrapRequest r@InternalTerminateRequest{})       = action2 s r-  doActivity s (WrapRequest r@InternalLoadRequest{})            = action2 s r+  doActivity s (WrapRequest r@InitializeRequest{})              = action s r+  doActivity s (WrapRequest r@LaunchRequest{})                  = action s r+  doActivity s (WrapRequest r@DisconnectRequest{})              = action s r+  doActivity s (WrapRequest r@PauseRequest{})                   = action s r+  doActivity s (WrapRequest r@TerminateRequest{})               = action s r+  doActivity s (WrapRequest r@SetBreakpointsRequest{})          = action s r+  doActivity s (WrapRequest r@SetFunctionBreakpointsRequest{})  = action s r+  doActivity s (WrapRequest r@SetExceptionBreakpointsRequest{}) = action s r+  doActivity s (WrapRequest r@ConfigurationDoneRequest{})       = action s r+  doActivity s (WrapRequest r@ThreadsRequest{})                 = action s r+  doActivity s (WrapRequest r@StackTraceRequest{})              = action s r+  doActivity s (WrapRequest r@ScopesRequest{})                  = action s r+  doActivity s (WrapRequest r@VariablesRequest{})               = action s r+  doActivity s (WrapRequest r@ContinueRequest{})                = action s r+  doActivity s (WrapRequest r@NextRequest{})                    = action s r+  doActivity s (WrapRequest r@StepInRequest{})                  = action s r+  doActivity s (WrapRequest r@EvaluateRequest{})                = action s r+  doActivity s (WrapRequest r@CompletionsRequest{})             = action s r+  doActivity s (WrapRequest r@InternalTransitRequest{})         = action s r+  doActivity s (WrapRequest r@InternalTerminateRequest{})       = action s r+  doActivity s (WrapRequest r@InternalLoadRequest{})            = action s r  -- | --   default nop.@@ -80,7 +80,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF ContaminatedStateData DAP.TerminateRequest where-  action2 _ (TerminateRequest req) = do+  action _ (TerminateRequest req) = do     liftIO $ L.debugM _LOG_APP $ "ContaminatedState TerminateRequest called. " ++ show req      SU.terminateRequest req@@ -91,7 +91,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF ContaminatedStateData DAP.SetBreakpointsRequest where-  action2 _ (SetBreakpointsRequest req) = do+  action _ (SetBreakpointsRequest req) = do     liftIO $ L.debugM _LOG_APP $ "ContaminatedState SetBreakpointsRequest called. " ++ show req     resSeq <- U.getIncreasedResponseSequence     let res = DAP.defaultSetBreakpointsResponse {@@ -108,7 +108,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF ContaminatedStateData DAP.SetFunctionBreakpointsRequest where-  action2 _ (SetFunctionBreakpointsRequest req) = do+  action _ (SetFunctionBreakpointsRequest req) = do     liftIO $ L.debugM _LOG_APP $ "ContaminatedState SetFunctionBreakpointsRequest called. " ++ show req     resSeq <- U.getIncreasedResponseSequence     let res = DAP.defaultSetFunctionBreakpointsResponse {@@ -125,7 +125,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF ContaminatedStateData DAP.SetExceptionBreakpointsRequest where-  action2 _ (SetExceptionBreakpointsRequest req) = do+  action _ (SetExceptionBreakpointsRequest req) = do     liftIO $ L.debugM _LOG_APP $ "ContaminatedState SetExceptionBreakpointsRequest called. " ++ show req     resSeq <- U.getIncreasedResponseSequence     let res = DAP.defaultSetExceptionBreakpointsResponse {@@ -147,7 +147,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF ContaminatedStateData DAP.ThreadsRequest where-  action2 _ (ThreadsRequest req) = do+  action _ (ThreadsRequest req) = do     liftIO $ L.debugM _LOG_APP $ "ContaminatedState ThreadsRequest called. " ++ show req     resSeq <- U.getIncreasedResponseSequence     let res = DAP.defaultThreadsResponse {@@ -164,7 +164,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF ContaminatedStateData DAP.StackTraceRequest where-  action2 _ (StackTraceRequest req) = do+  action _ (StackTraceRequest req) = do     liftIO $ L.debugM _LOG_APP $ "ContaminatedState StackTraceRequest called. " ++ show req     resSeq <- U.getIncreasedResponseSequence     let res = DAP.defaultStackTraceResponse {@@ -181,7 +181,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF ContaminatedStateData DAP.ScopesRequest where-  action2 _ (ScopesRequest req) = do+  action _ (ScopesRequest req) = do     liftIO $ L.debugM _LOG_APP $ "ContaminatedState ScopesRequest called. " ++ show req     resSeq <- U.getIncreasedResponseSequence     let res = DAP.defaultScopesResponse {@@ -198,7 +198,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF ContaminatedStateData DAP.VariablesRequest where-  action2 _ (VariablesRequest req) = do+  action _ (VariablesRequest req) = do     liftIO $ L.debugM _LOG_APP $ "ContaminatedState VariablesRequest called. " ++ show req     resSeq <- U.getIncreasedResponseSequence     let res = DAP.defaultVariablesResponse {@@ -215,7 +215,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF ContaminatedStateData DAP.ContinueRequest where-  action2 _ (ContinueRequest req) = do+  action _ (ContinueRequest req) = do     liftIO $ L.debugM _LOG_APP $ "ContaminatedState ContinueRequest called. " ++ show req     restartEvent     return $ Just Contaminated_Shutdown@@ -224,7 +224,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF ContaminatedStateData DAP.NextRequest where-  action2 _ (NextRequest req) = do+  action _ (NextRequest req) = do     liftIO $ L.debugM _LOG_APP $ "ContaminatedState NextRequest called. " ++ show req     restartEvent     return $ Just Contaminated_Shutdown@@ -233,7 +233,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF ContaminatedStateData DAP.StepInRequest where-  action2 _ (StepInRequest req) = do+  action _ (StepInRequest req) = do     liftIO $ L.debugM _LOG_APP $ "ContaminatedState StepInRequest called. " ++ show req     restartEvent     return $ Just Contaminated_Shutdown@@ -242,7 +242,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF ContaminatedStateData DAP.EvaluateRequest where-  action2 _ (EvaluateRequest req) = do+  action _ (EvaluateRequest req) = do     liftIO $ L.debugM _LOG_APP $ "ContaminatedState EvaluateRequest called. " ++ show req     SU.evaluateRequest req @@ -250,7 +250,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF ContaminatedStateData DAP.CompletionsRequest where-  action2 _ (CompletionsRequest req) = do+  action _ (CompletionsRequest req) = do     liftIO $ L.debugM _LOG_APP $ "ContaminatedState CompletionsRequest called. " ++ show req     SU.completionsRequest req @@ -263,7 +263,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF ContaminatedStateData HdaInternalTerminateRequest where-  action2 _ (InternalTerminateRequest req) = do+  action _ (InternalTerminateRequest req) = do     liftIO $ L.debugM _LOG_APP $ "ContaminatedState InternalTerminateRequest called. " ++ show req     SU.internalTerminateRequest     return $ Just Contaminated_Shutdown@@ -272,7 +272,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF ContaminatedStateData HdaInternalLoadRequest where-  action2 _ (InternalLoadRequest req) = do+  action _ (InternalLoadRequest req) = do     liftIO $ L.debugM _LOG_APP $ "ContaminatedState InternalLoadRequest called. " ++ show req     SU.loadHsFile $ pathHdaInternalLoadRequest req     return Nothing

src/Haskell/Debug/Adapter/State/DebugRun.hs view

@@ -9,8 +9,6 @@ import Control.Monad.Except import Control.Lens import qualified Text.Read as R-import qualified Data.List as L-import qualified Data.String.Utils as U  import qualified Haskell.DAP as DAP import Haskell.Debug.Adapter.Constant@@ -45,27 +43,27 @@    -- |   ---  doActivity s (WrapRequest r@InitializeRequest{})              = action2 s r-  doActivity s (WrapRequest r@LaunchRequest{})                  = action2 s r-  doActivity s (WrapRequest r@DisconnectRequest{})              = action2 s r-  doActivity s (WrapRequest r@PauseRequest{})                   = action2 s r-  doActivity s (WrapRequest r@TerminateRequest{})               = action2 s r-  doActivity s (WrapRequest r@SetBreakpointsRequest{})          = action2 s r-  doActivity s (WrapRequest r@SetFunctionBreakpointsRequest{})  = action2 s r-  doActivity s (WrapRequest r@SetExceptionBreakpointsRequest{}) = action2 s r-  doActivity s (WrapRequest r@ConfigurationDoneRequest{})       = action2 s r-  doActivity s (WrapRequest r@ThreadsRequest{})                 = action2 s r-  doActivity s (WrapRequest r@StackTraceRequest{})              = action2 s r-  doActivity s (WrapRequest r@ScopesRequest{})                  = action2 s r-  doActivity s (WrapRequest r@VariablesRequest{})               = action2 s r-  doActivity s (WrapRequest r@ContinueRequest{})                = action2 s r-  doActivity s (WrapRequest r@NextRequest{})                    = action2 s r-  doActivity s (WrapRequest r@StepInRequest{})                  = action2 s r-  doActivity s (WrapRequest r@EvaluateRequest{})                = action2 s r-  doActivity s (WrapRequest r@CompletionsRequest{})             = action2 s r-  doActivity s (WrapRequest r@InternalTransitRequest{})         = action2 s r-  doActivity s (WrapRequest r@InternalTerminateRequest{})       = action2 s r-  doActivity s (WrapRequest r@InternalLoadRequest{})            = action2 s r+  doActivity s (WrapRequest r@InitializeRequest{})              = action s r+  doActivity s (WrapRequest r@LaunchRequest{})                  = action s r+  doActivity s (WrapRequest r@DisconnectRequest{})              = action s r+  doActivity s (WrapRequest r@PauseRequest{})                   = action s r+  doActivity s (WrapRequest r@TerminateRequest{})               = action s r+  doActivity s (WrapRequest r@SetBreakpointsRequest{})          = action s r+  doActivity s (WrapRequest r@SetFunctionBreakpointsRequest{})  = action s r+  doActivity s (WrapRequest r@SetExceptionBreakpointsRequest{}) = action s r+  doActivity s (WrapRequest r@ConfigurationDoneRequest{})       = action s r+  doActivity s (WrapRequest r@ThreadsRequest{})                 = action s r+  doActivity s (WrapRequest r@StackTraceRequest{})              = action s r+  doActivity s (WrapRequest r@ScopesRequest{})                  = action s r+  doActivity s (WrapRequest r@VariablesRequest{})               = action s r+  doActivity s (WrapRequest r@ContinueRequest{})                = action s r+  doActivity s (WrapRequest r@NextRequest{})                    = action s r+  doActivity s (WrapRequest r@StepInRequest{})                  = action s r+  doActivity s (WrapRequest r@EvaluateRequest{})                = action s r+  doActivity s (WrapRequest r@CompletionsRequest{})             = action s r+  doActivity s (WrapRequest r@InternalTransitRequest{})         = action s r+  doActivity s (WrapRequest r@InternalTerminateRequest{})       = action s r+  doActivity s (WrapRequest r@InternalLoadRequest{})            = action s r  -- | --   default nop.@@ -105,8 +103,8 @@       funcBp   = (startupFile, DAP.FunctionBreakpoint funcName Nothing Nothing)       cmd = ":dap-set-function-breakpoint " ++ U.showDAP funcBp -  P.cmdAndOut cmd-  res <- P.expectH P.stdoutCallBk+  P.command cmd+  res <- P.expectPmpt    withAdhocAddDapHeader $ filter (U.startswith _DAP_HEADER) res @@ -137,8 +135,8 @@     adhocDelBreakpoint bp = do       let cmd = ":dap-delete-breakpoint " ++ U.showDAP bp -      P.cmdAndOut cmd-      res <- P.expectH P.stdoutCallBk+      P.command cmd+      res <- P.expectPmpt        withAdhocDelDapHeader $ filter (U.startswith _DAP_HEADER) res @@ -177,21 +175,12 @@           cmd = dap ++ U.showDAP args           dbg = dap ++ show args -      P.cmdAndOut cmd+      P.command cmd       U.debugEV _LOG_APP dbg-      P.expectH $ P.funcCallBk lineCallBk+      P.expectPmpt >>= SU.takeDapResult >>= dapHdl        return () --    lineCallBk :: Bool -> String -> AppContext ()-    lineCallBk True  s = U.sendStdoutEvent s-    lineCallBk False s-      | L.isPrefixOf _DAP_HEADER s = do-        U.debugEV _LOG_APP s-        dapHdl $ drop (length _DAP_HEADER) s-      | otherwise = U.sendStdoutEventLF s-     -- |     --     dapHdl :: String -> AppContext ()@@ -213,7 +202,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF DebugRunStateData DAP.SetBreakpointsRequest where-  action2 _ (SetBreakpointsRequest req) = do+  action _ (SetBreakpointsRequest req) = do     liftIO $ L.debugM _LOG_APP $ "DebugRunState SetBreakpointsRequest called. " ++ show req     SU.setBreakpointsRequest req @@ -221,7 +210,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF DebugRunStateData DAP.SetExceptionBreakpointsRequest where-  action2 _ (SetExceptionBreakpointsRequest req) = do+  action _ (SetExceptionBreakpointsRequest req) = do     liftIO $ L.debugM _LOG_APP $ "DebugRunState SetExceptionBreakpointsRequest called. " ++ show req     SU.setExceptionBreakpointsRequest req @@ -229,7 +218,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF DebugRunStateData DAP.SetFunctionBreakpointsRequest where-  action2 _ (SetFunctionBreakpointsRequest req) = do+  action _ (SetFunctionBreakpointsRequest req) = do     liftIO $ L.debugM _LOG_APP $ "DebugRunState SetFunctionBreakpointsRequest called. " ++ show req     SU.setFunctionBreakpointsRequest req @@ -242,7 +231,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF DebugRunStateData DAP.EvaluateRequest where-  action2 _ (EvaluateRequest req) = do+  action _ (EvaluateRequest req) = do     liftIO $ L.debugM _LOG_APP $ "DebugRunState EvaluateRequest called. " ++ show req     SU.evaluateRequest req @@ -250,7 +239,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF DebugRunStateData DAP.CompletionsRequest where-  action2 _ (CompletionsRequest req) = do+  action _ (CompletionsRequest req) = do     liftIO $ L.debugM _LOG_APP $ "DebugRunState CompletionsRequest called. " ++ show req     SU.completionsRequest req @@ -263,7 +252,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF DebugRunStateData HdaInternalLoadRequest where-  action2 _ (InternalLoadRequest req) = do+  action _ (InternalLoadRequest req) = do     liftIO $ L.debugM _LOG_APP $ "DebugRunState InternalLoadRequest called. " ++ show req     SU.loadHsFile $ pathHdaInternalLoadRequest req     return $ Just DebugRun_Contaminated

src/Haskell/Debug/Adapter/State/DebugRun/Continue.hs view

@@ -6,7 +6,6 @@ import Control.Monad.IO.Class import qualified System.Log.Logger as L import qualified Text.Read as R-import qualified Data.List as L import Control.Monad.Except  import qualified Haskell.DAP as DAP@@ -14,12 +13,13 @@ import Haskell.Debug.Adapter.Constant import qualified Haskell.Debug.Adapter.Utility as U import qualified Haskell.Debug.Adapter.GHCi as P+import qualified Haskell.Debug.Adapter.State.Utility as SU  -- | --  Any errors should be sent back as False result Response -- instance StateActivityIF DebugRunStateData DAP.ContinueRequest where-  action2 _ (ContinueRequest req) = do+  action _ (ContinueRequest req) = do     liftIO $ L.debugM _LOG_APP $ "DebugRunState ContinueRequest called. " ++ show req     app req @@ -33,9 +33,9 @@       cmd = dap ++ U.showDAP args       dbg = dap ++ show args -  P.cmdAndOut cmd+  P.command cmd   U.debugEV _LOG_APP dbg-  P.expectH $ P.funcCallBk lineCallBk+  P.expectPmpt >>= SU.takeDapResult >>= dapHdl    resSeq <- U.getIncreasedResponseSequence   let res = DAP.defaultContinueResponse {@@ -49,13 +49,6 @@   return Nothing    where-    lineCallBk :: Bool -> String -> AppContext ()-    lineCallBk True  s = U.sendStdoutEvent s-    lineCallBk False s-      | L.isPrefixOf _DAP_HEADER s = do-        U.debugEV _LOG_APP s-        dapHdl $ drop (length _DAP_HEADER) s-      | otherwise = U.sendStdoutEventLF s      -- |     --

src/Haskell/Debug/Adapter/State/DebugRun/InternalTerminate.hs view

@@ -16,7 +16,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF DebugRunStateData HdaInternalTerminateRequest where-  action2 _ (InternalTerminateRequest req) = do+  action _ (InternalTerminateRequest req) = do     liftIO $ L.debugM _LOG_APP $ "DebugRunState InternalTerminateRequest called. " ++ show req     app req

src/Haskell/Debug/Adapter/State/DebugRun/Next.hs view

@@ -6,7 +6,6 @@ import Control.Monad.IO.Class import qualified System.Log.Logger as L import qualified Text.Read as R-import qualified Data.List as L import Control.Monad.Except  import qualified Haskell.DAP as DAP@@ -14,12 +13,13 @@ import Haskell.Debug.Adapter.Constant import qualified Haskell.Debug.Adapter.Utility as U import qualified Haskell.Debug.Adapter.GHCi as P+import qualified Haskell.Debug.Adapter.State.Utility as SU  -- | --  Any errors should be sent back as False result Response -- instance StateActivityIF DebugRunStateData DAP.NextRequest where-  action2 _ (NextRequest req) = do+  action _ (NextRequest req) = do     liftIO $ L.debugM _LOG_APP $ "DebugRunState NextRequest called. " ++ show req     app req @@ -33,9 +33,9 @@       cmd = dap ++ U.showDAP args       dbg = dap ++ show args -  P.cmdAndOut cmd+  P.command cmd   U.debugEV _LOG_APP dbg-  P.expectH $ P.funcCallBk lineCallBk+  P.expectPmpt >>= SU.takeDapResult >>= dapHdl    resSeq <- U.getIncreasedResponseSequence   let res = DAP.defaultNextResponse {@@ -49,13 +49,6 @@   return Nothing    where-    lineCallBk :: Bool -> String -> AppContext ()-    lineCallBk True  s = U.sendStdoutEvent s-    lineCallBk False s-      | L.isPrefixOf _DAP_HEADER s = do-        U.debugEV _LOG_APP s-        dapHdl $ drop (length _DAP_HEADER) s-      | otherwise = U.sendStdoutEventLF s      -- |     --

src/Haskell/Debug/Adapter/State/DebugRun/Scopes.hs view

@@ -6,7 +6,6 @@ import Control.Monad.IO.Class import qualified System.Log.Logger as L import qualified Text.Read as R-import qualified Data.List as L import Control.Monad.Except  import qualified Haskell.DAP as DAP@@ -14,13 +13,14 @@ import Haskell.Debug.Adapter.Constant import qualified Haskell.Debug.Adapter.Utility as U import qualified Haskell.Debug.Adapter.GHCi as P+import qualified Haskell.Debug.Adapter.State.Utility as SU   -- | --  Any errors should be sent back as False result Response -- instance StateActivityIF DebugRunStateData DAP.ScopesRequest where-  action2 _ (ScopesRequest req) = do+  action _ (ScopesRequest req) = do     liftIO $ L.debugM _LOG_APP $ "DebugRunState ScopesRequest called. " ++ show req     app req @@ -34,20 +34,13 @@       cmd = dap ++ U.showDAP args       dbg = dap ++ show args -  P.cmdAndOut cmd+  P.command cmd   U.debugEV _LOG_APP dbg-  P.expectH $ P.funcCallBk lineCallBk+  P.expectPmpt >>= SU.takeDapResult >>= dapHdl    return Nothing    where-    lineCallBk :: Bool -> String -> AppContext ()-    lineCallBk True  s = U.sendStdoutEvent s-    lineCallBk False s-      | L.isPrefixOf _DAP_HEADER s = do-        U.debugEV _LOG_APP s-        dapHdl $ drop (length _DAP_HEADER) s-      | otherwise = U.sendStdoutEventLF s      -- |     --

src/Haskell/Debug/Adapter/State/DebugRun/StackTrace.hs view

@@ -6,7 +6,6 @@ import Control.Monad.IO.Class import qualified System.Log.Logger as L import qualified Text.Read as R-import qualified Data.List as L import Control.Monad.Except  import qualified Haskell.DAP as DAP@@ -14,13 +13,14 @@ import Haskell.Debug.Adapter.Constant import qualified Haskell.Debug.Adapter.Utility as U import qualified Haskell.Debug.Adapter.GHCi as P+import qualified Haskell.Debug.Adapter.State.Utility as SU   -- | --  Any errors should be sent back as False result Response -- instance StateActivityIF DebugRunStateData DAP.StackTraceRequest where-  action2 _ (StackTraceRequest req) = do+  action _ (StackTraceRequest req) = do     liftIO $ L.debugM _LOG_APP $ "DebugRunState StackTraceRequest called. " ++ show req     app req @@ -34,21 +34,13 @@       cmd = dap ++ U.showDAP args       dbg = dap ++ show args -  P.cmdAndOut cmd+  P.command cmd   U.debugEV _LOG_APP dbg-  P.expectH $ P.funcCallBk lineCallBk+  P.expectPmpt >>= SU.takeDapResult >>= dapHdl    return Nothing    where-    lineCallBk :: Bool -> String -> AppContext ()-    lineCallBk True  s = U.sendStdoutEvent s-    lineCallBk False s-      | L.isPrefixOf _DAP_HEADER s = do-        U.debugEV _LOG_APP s-        dapHdl $ drop (length _DAP_HEADER) s-      | otherwise = U.sendStdoutEventLF s-     -- |     --     dapHdl :: String -> AppContext ()

src/Haskell/Debug/Adapter/State/DebugRun/StepIn.hs view

@@ -6,7 +6,6 @@ import Control.Monad.IO.Class import qualified System.Log.Logger as L import qualified Text.Read as R-import qualified Data.List as L import Control.Monad.Except  import qualified Haskell.DAP as DAP@@ -14,12 +13,13 @@ import Haskell.Debug.Adapter.Constant import qualified Haskell.Debug.Adapter.Utility as U import qualified Haskell.Debug.Adapter.GHCi as P+import qualified Haskell.Debug.Adapter.State.Utility as SU  -- | --  Any errors should be sent back as False result Response -- instance StateActivityIF DebugRunStateData DAP.StepInRequest where-  action2 _ (StepInRequest req) = do+  action _ (StepInRequest req) = do     liftIO $ L.debugM _LOG_APP $ "DebugRunState StepInRequest called. " ++ show req     app req @@ -33,9 +33,9 @@       cmd = dap ++ U.showDAP args       dbg = dap ++ show args -  P.cmdAndOut cmd+  P.command cmd   U.debugEV _LOG_APP dbg-  P.expectH $ P.funcCallBk lineCallBk+  P.expectPmpt >>= SU.takeDapResult >>= dapHdl    resSeq <- U.getIncreasedResponseSequence   let res = DAP.defaultStepInResponse {@@ -49,14 +49,6 @@   return Nothing    where-    lineCallBk :: Bool -> String -> AppContext ()-    lineCallBk True  s = U.sendStdoutEvent s-    lineCallBk False s-      | L.isPrefixOf _DAP_HEADER s = do-        U.debugEV _LOG_APP s-        dapHdl $ drop (length _DAP_HEADER) s-      | otherwise = U.sendStdoutEventLF s-     -- |     --     dapHdl :: String -> AppContext ()

src/Haskell/Debug/Adapter/State/DebugRun/Terminate.hs view

@@ -17,7 +17,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF DebugRunStateData DAP.TerminateRequest where-  action2 _ (TerminateRequest req) = do+  action _ (TerminateRequest req) = do     liftIO $ L.debugM _LOG_APP $ "DebugRunState TerminateRequest called. " ++ show req     app req

src/Haskell/Debug/Adapter/State/DebugRun/Threads.hs view

@@ -15,7 +15,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF DebugRunStateData DAP.ThreadsRequest where-  action2 _ (ThreadsRequest req) = do+  action _ (ThreadsRequest req) = do     liftIO $ L.debugM _LOG_APP $ "DebugRunState ThreadsRequest called. " ++ show req     app req

src/Haskell/Debug/Adapter/State/DebugRun/Variables.hs view

@@ -6,7 +6,6 @@ import Control.Monad.IO.Class import qualified System.Log.Logger as L import qualified Text.Read as R-import qualified Data.List as L import Control.Monad.Except  import qualified Haskell.DAP as DAP@@ -14,12 +13,13 @@ import Haskell.Debug.Adapter.Constant import qualified Haskell.Debug.Adapter.Utility as U import qualified Haskell.Debug.Adapter.GHCi as P+import qualified Haskell.Debug.Adapter.State.Utility as SU  -- | --  Any errors should be sent back as False result Response -- instance StateActivityIF DebugRunStateData DAP.VariablesRequest where-  action2 _ (VariablesRequest req) = do+  action _ (VariablesRequest req) = do     liftIO $ L.debugM _LOG_APP $ "DebugRunState VariablesRequest called. " ++ show req     app req @@ -33,20 +33,13 @@       cmd = dap ++ U.showDAP args       dbg = dap ++ show args -  P.cmdAndOut cmd+  P.command cmd   U.debugEV _LOG_APP dbg-  P.expectH $ P.funcCallBk lineCallBk+  P.expectPmpt >>= SU.takeDapResult >>= dapHdl    return Nothing    where-    lineCallBk :: Bool -> String -> AppContext ()-    lineCallBk True  s = U.sendStdoutEvent s-    lineCallBk False s-      | L.isPrefixOf _DAP_HEADER s = do-        U.debugEV _LOG_APP s-        dapHdl $ drop (length _DAP_HEADER) s-      | otherwise = U.sendStdoutEventLF s      -- |     --

src/Haskell/Debug/Adapter/State/GHCiRun.hs view

@@ -29,27 +29,27 @@    -- |   ---  doActivity s (WrapRequest r@InitializeRequest{})              = action2 s r-  doActivity s (WrapRequest r@LaunchRequest{})                  = action2 s r-  doActivity s (WrapRequest r@DisconnectRequest{})              = action2 s r-  doActivity s (WrapRequest r@PauseRequest{})                   = action2 s r-  doActivity s (WrapRequest r@TerminateRequest{})               = action2 s r-  doActivity s (WrapRequest r@SetBreakpointsRequest{})          = action2 s r-  doActivity s (WrapRequest r@SetFunctionBreakpointsRequest{})  = action2 s r-  doActivity s (WrapRequest r@SetExceptionBreakpointsRequest{}) = action2 s r-  doActivity s (WrapRequest r@ConfigurationDoneRequest{})       = action2 s r-  doActivity s (WrapRequest r@ThreadsRequest{})                 = action2 s r-  doActivity s (WrapRequest r@StackTraceRequest{})              = action2 s r-  doActivity s (WrapRequest r@ScopesRequest{})                  = action2 s r-  doActivity s (WrapRequest r@VariablesRequest{})               = action2 s r-  doActivity s (WrapRequest r@ContinueRequest{})                = action2 s r-  doActivity s (WrapRequest r@NextRequest{})                    = action2 s r-  doActivity s (WrapRequest r@StepInRequest{})                  = action2 s r-  doActivity s (WrapRequest r@EvaluateRequest{})                = action2 s r-  doActivity s (WrapRequest r@CompletionsRequest{})             = action2 s r-  doActivity s (WrapRequest r@InternalTransitRequest{})         = action2 s r-  doActivity s (WrapRequest r@InternalTerminateRequest{})       = action2 s r-  doActivity s (WrapRequest r@InternalLoadRequest{})            = action2 s r+  doActivity s (WrapRequest r@InitializeRequest{})              = action s r+  doActivity s (WrapRequest r@LaunchRequest{})                  = action s r+  doActivity s (WrapRequest r@DisconnectRequest{})              = action s r+  doActivity s (WrapRequest r@PauseRequest{})                   = action s r+  doActivity s (WrapRequest r@TerminateRequest{})               = action s r+  doActivity s (WrapRequest r@SetBreakpointsRequest{})          = action s r+  doActivity s (WrapRequest r@SetFunctionBreakpointsRequest{})  = action s r+  doActivity s (WrapRequest r@SetExceptionBreakpointsRequest{}) = action s r+  doActivity s (WrapRequest r@ConfigurationDoneRequest{})       = action s r+  doActivity s (WrapRequest r@ThreadsRequest{})                 = action s r+  doActivity s (WrapRequest r@StackTraceRequest{})              = action s r+  doActivity s (WrapRequest r@ScopesRequest{})                  = action s r+  doActivity s (WrapRequest r@VariablesRequest{})               = action s r+  doActivity s (WrapRequest r@ContinueRequest{})                = action s r+  doActivity s (WrapRequest r@NextRequest{})                    = action s r+  doActivity s (WrapRequest r@StepInRequest{})                  = action s r+  doActivity s (WrapRequest r@EvaluateRequest{})                = action s r+  doActivity s (WrapRequest r@CompletionsRequest{})             = action s r+  doActivity s (WrapRequest r@InternalTransitRequest{})         = action s r+  doActivity s (WrapRequest r@InternalTerminateRequest{})       = action s r+  doActivity s (WrapRequest r@InternalLoadRequest{})            = action s r  -- | --   default nop.@@ -75,7 +75,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF GHCiRunStateData DAP.TerminateRequest where-  action2 _ (TerminateRequest req) = do+  action _ (TerminateRequest req) = do     liftIO $ L.debugM _LOG_APP $ "GHCiRunState TerminateRequest called. " ++ show req      SU.terminateRequest req@@ -86,7 +86,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF GHCiRunStateData DAP.SetBreakpointsRequest where-  action2 _ (SetBreakpointsRequest req) = do+  action _ (SetBreakpointsRequest req) = do     liftIO $ L.debugM _LOG_APP $ "GHCiRunState SetBreakpointsRequest called. " ++ show req     SU.setBreakpointsRequest req @@ -94,7 +94,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF GHCiRunStateData DAP.SetExceptionBreakpointsRequest where-  action2 _ (SetExceptionBreakpointsRequest req) = do+  action _ (SetExceptionBreakpointsRequest req) = do     liftIO $ L.debugM _LOG_APP $ "GHCiRunState SetExceptionBreakpointsRequest called. " ++ show req     SU.setExceptionBreakpointsRequest req @@ -102,7 +102,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF GHCiRunStateData DAP.SetFunctionBreakpointsRequest where-  action2 _ (SetFunctionBreakpointsRequest req) = do+  action _ (SetFunctionBreakpointsRequest req) = do     liftIO $ L.debugM _LOG_APP $ "GHCiRunState SetFunctionBreakpointsRequest called. " ++ show req     SU.setFunctionBreakpointsRequest req @@ -110,7 +110,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF GHCiRunStateData DAP.ThreadsRequest where-  action2 _ (ThreadsRequest req) = do+  action _ (ThreadsRequest req) = do     liftIO $ L.debugM _LOG_APP $ "GHCiRunState ThreadsRequest called. " ++ show req     resSeq <- U.getIncreasedResponseSequence     let res = DAP.defaultThreadsResponse {@@ -127,7 +127,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF GHCiRunStateData DAP.StackTraceRequest where-  action2 _ (StackTraceRequest req) = do+  action _ (StackTraceRequest req) = do     liftIO $ L.debugM _LOG_APP $ "GHCiRunState StackTraceRequest called. " ++ show req     resSeq <- U.getIncreasedResponseSequence     let res = DAP.defaultStackTraceResponse {@@ -144,7 +144,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF GHCiRunStateData DAP.ScopesRequest where-  action2 _ (ScopesRequest req) = do+  action _ (ScopesRequest req) = do     liftIO $ L.debugM _LOG_APP $ "GHCiRunState ScopesRequest called. " ++ show req     resSeq <- U.getIncreasedResponseSequence     let res = DAP.defaultScopesResponse {@@ -161,7 +161,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF GHCiRunStateData DAP.VariablesRequest where-  action2 _ (VariablesRequest req) = do+  action _ (VariablesRequest req) = do     liftIO $ L.debugM _LOG_APP $ "GHCiRunState VariablesRequest called. " ++ show req     resSeq <- U.getIncreasedResponseSequence     let res = DAP.defaultVariablesResponse {@@ -179,7 +179,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF GHCiRunStateData DAP.ContinueRequest where-  action2 _ (ContinueRequest req) = do+  action _ (ContinueRequest req) = do     liftIO $ L.debugM _LOG_APP $ "GHCiRunState ContinueRequest called. " ++ show req     resSeq <- U.getIncreasedResponseSequence     let res = DAP.defaultContinueResponse {@@ -197,7 +197,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF GHCiRunStateData DAP.NextRequest where-  action2 _ (NextRequest req) = do+  action _ (NextRequest req) = do     liftIO $ L.debugM _LOG_APP $ "GHCiRunState NextRequest called. " ++ show req     resSeq <- U.getIncreasedResponseSequence     let res = DAP.defaultNextResponse {@@ -215,7 +215,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF GHCiRunStateData DAP.StepInRequest where-  action2 _ (StepInRequest req) = do+  action _ (StepInRequest req) = do     liftIO $ L.debugM _LOG_APP $ "GHCiRunState StepInRequest called. " ++ show req     resSeq <- U.getIncreasedResponseSequence     let res = DAP.defaultStepInResponse {@@ -233,7 +233,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF GHCiRunStateData DAP.EvaluateRequest where-  action2 _ (EvaluateRequest req) = do+  action _ (EvaluateRequest req) = do     liftIO $ L.debugM _LOG_APP $ "GHCiRunState EvaluateRequest called. " ++ show req     SU.evaluateRequest req @@ -241,7 +241,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF GHCiRunStateData DAP.CompletionsRequest where-  action2 _ (CompletionsRequest req) = do+  action _ (CompletionsRequest req) = do     liftIO $ L.debugM _LOG_APP $ "GHCiRunState CompletionsRequest called. " ++ show req     SU.completionsRequest req @@ -254,7 +254,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF GHCiRunStateData HdaInternalTerminateRequest where-  action2 _ (InternalTerminateRequest req) = do+  action _ (InternalTerminateRequest req) = do     liftIO $ L.debugM _LOG_APP $ "GHCiRunState InternalTerminateRequest called. " ++ show req     SU.internalTerminateRequest     return $ Just GHCiRun_Shutdown@@ -263,7 +263,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF GHCiRunStateData HdaInternalLoadRequest where-  action2 _ (InternalLoadRequest req) = do+  action _ (InternalLoadRequest req) = do     liftIO $ L.debugM _LOG_APP $ "GHCiRunState InternalTerminateRequest called. " ++ show req     SU.internalTerminateRequest     return $ Just GHCiRun_Shutdown

src/Haskell/Debug/Adapter/State/GHCiRun/ConfigurationDone.hs view

@@ -18,7 +18,7 @@ --  Any errors should be sent back as False result Response -- instance StateActivityIF GHCiRunStateData DAP.ConfigurationDoneRequest where-  action2 _ (ConfigurationDoneRequest req) = do+  action _ (ConfigurationDoneRequest req) = do     liftIO $ L.debugM _LOG_APP $ "GHCiRunState ConfigurationDoneRequest called. " ++ show req     app req

src/Haskell/Debug/Adapter/State/Init.hs view

@@ -31,27 +31,27 @@    -- |   ---  doActivity s (WrapRequest r@InitializeRequest{})              = action2 s r-  doActivity s (WrapRequest r@LaunchRequest{})                  = action2 s r-  doActivity s (WrapRequest r@DisconnectRequest{})              = action2 s r-  doActivity s (WrapRequest r@PauseRequest{})                   = action2 s r-  doActivity s (WrapRequest r@TerminateRequest{})               = action2 s r-  doActivity s (WrapRequest r@SetBreakpointsRequest{})          = action2 s r-  doActivity s (WrapRequest r@SetFunctionBreakpointsRequest{})  = action2 s r-  doActivity s (WrapRequest r@SetExceptionBreakpointsRequest{}) = action2 s r-  doActivity s (WrapRequest r@ConfigurationDoneRequest{})       = action2 s r-  doActivity s (WrapRequest r@ThreadsRequest{})                 = action2 s r-  doActivity s (WrapRequest r@StackTraceRequest{})              = action2 s r-  doActivity s (WrapRequest r@ScopesRequest{})                  = action2 s r-  doActivity s (WrapRequest r@VariablesRequest{})               = action2 s r-  doActivity s (WrapRequest r@ContinueRequest{})                = action2 s r-  doActivity s (WrapRequest r@NextRequest{})                    = action2 s r-  doActivity s (WrapRequest r@StepInRequest{})                  = action2 s r-  doActivity s (WrapRequest r@EvaluateRequest{})                = action2 s r-  doActivity s (WrapRequest r@CompletionsRequest{})             = action2 s r-  doActivity s (WrapRequest r@InternalTransitRequest{})         = action2 s r-  doActivity s (WrapRequest r@InternalTerminateRequest{})       = action2 s r-  doActivity s (WrapRequest r@InternalLoadRequest{})            = action2 s r+  doActivity s (WrapRequest r@InitializeRequest{})              = action s r+  doActivity s (WrapRequest r@LaunchRequest{})                  = action s r+  doActivity s (WrapRequest r@DisconnectRequest{})              = action s r+  doActivity s (WrapRequest r@PauseRequest{})                   = action s r+  doActivity s (WrapRequest r@TerminateRequest{})               = action s r+  doActivity s (WrapRequest r@SetBreakpointsRequest{})          = action s r+  doActivity s (WrapRequest r@SetFunctionBreakpointsRequest{})  = action s r+  doActivity s (WrapRequest r@SetExceptionBreakpointsRequest{}) = action s r+  doActivity s (WrapRequest r@ConfigurationDoneRequest{})       = action s r+  doActivity s (WrapRequest r@ThreadsRequest{})                 = action s r+  doActivity s (WrapRequest r@StackTraceRequest{})              = action s r+  doActivity s (WrapRequest r@ScopesRequest{})                  = action s r+  doActivity s (WrapRequest r@VariablesRequest{})               = action s r+  doActivity s (WrapRequest r@ContinueRequest{})                = action s r+  doActivity s (WrapRequest r@NextRequest{})                    = action s r+  doActivity s (WrapRequest r@StepInRequest{})                  = action s r+  doActivity s (WrapRequest r@EvaluateRequest{})                = action s r+  doActivity s (WrapRequest r@CompletionsRequest{})             = action s r+  doActivity s (WrapRequest r@InternalTransitRequest{})         = action s r+  doActivity s (WrapRequest r@InternalTerminateRequest{})       = action s r+  doActivity s (WrapRequest r@InternalLoadRequest{})            = action s r  -- | --   default nop.

src/Haskell/Debug/Adapter/State/Init/Initialize.hs view

@@ -18,7 +18,7 @@ --   Any errors should be critical. don't catch anything here. -- instance StateActivityIF InitStateData DAP.InitializeRequest where-  action2 _ (InitializeRequest req) = do+  action _ (InitializeRequest req) = do     liftIO $ L.debugM _LOG_APP $ "InitState InitializeRequest called. " ++ show req     app req

src/Haskell/Debug/Adapter/State/Init/Launch.hs view

@@ -13,7 +13,6 @@ import Text.Parsec import qualified Text.Read as R import qualified System.Log.Logger as L-import qualified Data.String.Utils as U import qualified Data.ByteString.Lazy as LB import qualified Data.List as L import qualified Data.Version as V@@ -31,7 +30,7 @@ --   Any errors should be critical. don't catch anything here. -- instance StateActivityIF InitStateData DAP.LaunchRequest where-  action2 _ (LaunchRequest req) = do+  action _ (LaunchRequest req) = do     liftIO $ L.debugM _LOG_APP $ "InitState LaunchRequest called. " ++ show req     app req @@ -185,32 +184,27 @@   opts <- addWithGHC (tail cmdList)    appStores <- get-  cwd <- liftIO $ readMVar $ appStores^.workspaceAppStores+  cwd <- U.liftIOE $ readMVar $ appStores^.workspaceAppStores -  liftIO $ L.debugM _LOG_APP $ "ghci initial prompt [" ++ initPmpt ++ "]."+  U.liftIOE $ L.debugM _LOG_APP $ "ghci initial prompt [" ++ initPmpt ++ "]." -  U.sendStdoutEventLF $ "CWD:" ++ cwd-  U.sendStdoutEventLF $ "CMD:" ++ L.intercalate " " (cmd : opts)-  U.sendStdoutEventLF ""+  U.sendConsoleEventLF $ "CWD: " ++ cwd+  U.sendConsoleEventLF $ "CMD: " ++ L.intercalate " " (cmd : opts)+  U.sendConsoleEventLF ""    P.startGHCi cmd opts cwd envs-  P.expect initPmpt expCallBK+  res <- P.expectInitPmpt initPmpt +  updateGHCiVersion res+   where-    expCallBK _ _ ([]) = return ()-    expCallBK True  acc (x:[]) = do-      U.sendStdoutEvent x-      updateGHCiVersion acc-    expCallBK False _ (x:[]) = U.sendStdoutEventLF x-    expCallBK True  _ xs = do-      mapM_ U.sendStdoutEventLF $ init xs-      U.sendStdoutEvent $ last xs-    expCallBK False _ xs = mapM_ U.sendStdoutEventLF xs      updateGHCiVersion acc = case parse verParser "getGHCiVersion" (unlines acc) of-      Right v -> updateGHCiVersion' v+      Right v -> do+        U.debugEV _LOG_APP $ "GHCi version is " ++ V.showVersion v+        updateGHCiVersion' v       Left e  -> do-        U.sendConsoleEventLF $ "can not parse ghci version. [" ++ show e ++ "] assumes "  ++ V.showVersion _BASE_GHCI_VERSION ++ "."+        U.sendConsoleEventLF $ "Can not parse ghci version. [" ++ show e ++ "]. Assumes "  ++ V.showVersion _BASE_GHCI_VERSION ++ "."         updateGHCiVersion' _BASE_GHCI_VERSION      verParser = do@@ -221,9 +215,8 @@       return $ V.makeVersion [read v1, read v2, read v3]      updateGHCiVersion' v = do-      -- U.debugEV _LOG_APP $ "GHCi version is " ++ V.showVersion v       mver <- view ghciVerAppStores <$> get-      liftIO $ putMVar mver v+      U.liftIOE $ putMVar mver v  -- | --@@ -234,15 +227,14 @@       cmd  = ":set prompt \""++pmpt++"\""       cmd2 = ":set prompt-cont \""++pmpt++"\"" -  P.cmdAndOut cmd-  P.expectH P.stdoutCallBk+  P.command cmd+  P.expectPmpt -  P.cmdAndOut cmd2-  P.expectH P.stdoutCallBk+  P.command cmd2+  P.expectPmpt    return () - -- | -- launchCmd :: DAP.LaunchRequest -> AppContext ()@@ -252,9 +244,9 @@       cmd = dap ++ U.showDAP args       dbg = dap ++ show args -  P.cmdAndOut cmd+  P.command cmd   U.debugEV _LOG_APP dbg-  P.expectH P.stdoutCallBk+  P.expectPmpt    return () @@ -267,8 +259,8 @@   args -> do     let cmd  = ":set args "++args -    P.cmdAndOut cmd-    P.expectH P.stdoutCallBk+    P.command cmd+    P.expectPmpt      return () @@ -279,6 +271,13 @@ loadStarupFile = do   file <- view startupAppStores <$> get   SU.loadHsFile file++  let cmd  = ":dap-context-modules "++  P.command cmd+  P.expectPmpt++  return ()   -- |

src/Haskell/Debug/Adapter/State/Utility.hs view

@@ -3,10 +3,8 @@  module Haskell.Debug.Adapter.State.Utility where --- import Control.Monad.IO.Class import qualified System.Log.Logger as L import qualified Text.Read as R-import qualified Data.List as L import Control.Monad.Except import Control.Concurrent (threadDelay) @@ -26,21 +24,13 @@       cmd = dap ++ U.showDAP args       dbg = dap ++ show args -  P.cmdAndOut cmd+  P.command cmd   U.debugEV _LOG_APP dbg-  P.expectH $ P.funcCallBk lineCallBk+  P.expectPmpt >>= takeDapResult >>= dapHdl    return Nothing    where-    lineCallBk :: Bool -> String -> AppContext ()-    lineCallBk True  s = U.sendStdoutEvent s-    lineCallBk False s-      | L.isPrefixOf _DAP_HEADER s = do-        U.debugEV _LOG_APP s-        dapHdl $ drop (length _DAP_HEADER) s-      | otherwise = U.sendStdoutEventLF s-     -- |     --     dapHdl :: String -> AppContext ()@@ -105,8 +95,8 @@     go opt = do       let cmd = ":set " ++ opt -      P.cmdAndOut cmd-      P.expectH $ P.stdoutCallBk+      P.command cmd+      P.expectPmpt   @@ -119,20 +109,13 @@       cmd = dap ++ U.showDAP args       dbg = dap ++ show args -  P.cmdAndOut cmd+  P.command cmd   U.debugEV _LOG_APP dbg-  P.expectH $ P.funcCallBk lineCallBk+  P.expectPmpt >>= takeDapResult >>= dapHdl    return Nothing    where-    lineCallBk :: Bool -> String -> AppContext ()-    lineCallBk True  s = U.sendStdoutEvent s-    lineCallBk False s-      | L.isPrefixOf _DAP_HEADER s = do-        U.debugEV _LOG_APP s-        dapHdl $ drop (length _DAP_HEADER) s-      | otherwise = U.sendStdoutEventLF s      -- |     --@@ -175,8 +158,8 @@ terminateGHCi = do   let cmd = ":quit" -  P.cmdAndOut cmd-  P.expectEOF $ P.stdoutCallBk+  P.command cmd+  P.expectPmpt   return ()  @@ -190,22 +173,13 @@       cmd = dap ++ U.showDAP args       dbg = dap ++ show args -  P.cmdAndOut cmd+  P.command cmd   U.debugEV _LOG_APP dbg-  P.expectH $ P.funcCallBk lineCallBk+  P.expectPmpt >>= takeDapResult >>= dapHdl    return Nothing    where-    lineCallBk :: Bool -> String -> AppContext ()-    lineCallBk True  s = U.sendStdoutEvent s-    lineCallBk False s-      | L.isPrefixOf _DAP_HEADER s = do-        U.debugEV _LOG_APP s-        dapHdl $ drop (length _DAP_HEADER) s-      | otherwise = do-        liftIO $ L.errorM _LOG_APP s-        U.sendStdoutEventLF s      -- |     --@@ -250,8 +224,8 @@       size = "0-50"       cmd = ":complete repl " ++ size ++ " \"" ++ key ++ "\"" -  P.cmdAndOut cmd-  outs <- P.expectH P.stdoutCallBk+  P.command cmd+  outs <- P.expectPmpt    resSeq <- U.getIncreasedResponseSequence   let items = createItems outs@@ -320,8 +294,8 @@ loadHsFile file = do   let cmd  = ":load "++ file -  P.cmdAndOut cmd-  P.expectH P.stdoutCallBk+  P.command cmd+  P.expectPmpt    return () @@ -357,5 +331,13 @@      U.sendTerminatedEvent     U.sendExitedEvent+++-- |+--+takeDapResult :: [String] -> AppContext String+takeDapResult res = case filter (U.startswith _DAP_HEADER) res of+  (x:[]) -> return $ drop (length _DAP_HEADER) x+  _ -> throwError $ "invalid dap result from ghci. " ++ show res

src/Haskell/Debug/Adapter/Type.hs view

@@ -338,9 +338,9 @@ -- | -- class  (Show s, Show r) => StateActivityIF s r where-  action2 :: (AppState s) -> (Request r) -> AppContext (Maybe StateTransit)-  --action2 _ _ = return Nothing-  action2 s r = do+  action :: (AppState s) -> (Request r) -> AppContext (Maybe StateTransit)+  --action _ _ = return Nothing+  action s r = do     liftIO $ L.warningM _LOG_APP $ show s ++ " " ++ show r ++ " not supported. nop."     return Nothing

src/Haskell/Debug/Adapter/Utility.hs view

@@ -47,8 +47,8 @@   -- |---  --- +--+-- loadFile :: FilePath -> IO BS.ByteString loadFile path = do   bs <- C.runConduitRes@@ -58,15 +58,15 @@   -- |---  --- +--+-- saveFile :: FilePath -> BS.ByteString -> IO () saveFile path cont = saveFileBSL path $ BSL.fromStrict cont   -- |---  --- +--+-- saveFileBSL :: FilePath -> BSL.ByteString -> IO () saveFileBSL path cont = C.runConduitRes   $ C.sourceLbs cont@@ -74,14 +74,14 @@   -- |---  --- +--+-- add2File :: FilePath -> BS.ByteString -> IO () add2File path cont = add2FileBSL path $ BSL.fromStrict cont  -- |---  --- +--+-- add2FileBSL :: FilePath -> BSL.ByteString -> IO () add2FileBSL path cont = C.runConduitRes   $ C.sourceLbs cont@@ -89,17 +89,17 @@    where hdl = S.openFile path S.AppendMode -           + -- | --  utility--- +-- showEE :: (Show e) => Either e a -> Either ErrMsg a showEE (Right v) = Right v showEE (Left  e) = Left $ show e   -- |--- +-- runApp :: AppStores -> AppContext a -> IO (Either ErrMsg (a, AppStores)) runApp dat app = runExceptT $ runStateT app dat @@ -187,7 +187,7 @@                 DAP.seqOutputEvent = resSeq               , DAP.bodyOutputEvent = body               }-              +   addResponse $ OutputEvent outEvt  -- |@@ -232,7 +232,7 @@   mvar <- view logPriorityAppStores <$> get   logPR <- liftIO $ readMVar mvar   let msg' = if L.isSuffixOf _LF_STR msg then msg else msg ++ _LF_STR-   +   when (pr >= logPR) $ do     sendStdoutEvent $ "[" ++ show pr ++ "][" ++ name ++ "] " ++ msg' @@ -326,7 +326,7 @@       Nothing -> do         liftIO $ L.infoM _LOG_NAME "force kill ghci."         force-    +     force = killGHCi >> getGHCiExitCode >>= \case       Just c -> return c       Nothing -> do@@ -371,7 +371,7 @@       -- ghci and vscode can not rerun debugging without restart.       -- sendContinuedEvent       -- sendPauseEvent-      addRequestHP $ WrapRequest +      addRequestHP $ WrapRequest                    $ InternalTransitRequest                    $ HdaInternalTransitRequest DebugRun_Contaminated @@ -419,9 +419,9 @@              >>= go    where-    go hdl = liftIOE (Right <$> S.hGetLine hdl) >>= liftEither-    +    go hdl = liftIOE $ S.hGetLine hdl + -- | -- readChar :: S.Handle -> AppContext String@@ -433,8 +433,8 @@            >>= isNotEmpty    where-    go hdl = liftIOE (Right <$> S.hGetChar hdl) >>= liftEither-    +    go hdl = liftIOE $ S.hGetChar hdl+     toString c = return [c]  @@ -454,13 +454,13 @@                >>= isNotEmptyL    where-    go hdl = liftIOE (Right <$> BSL.hGet hdl c) >>= liftEither+    go hdl = liftIOE $ BSL.hGet hdl c   -- | -- isOpenHdl :: S.Handle -> AppContext S.Handle-isOpenHdl rHdl = liftIO (S.hIsOpen rHdl) >>= \case+isOpenHdl rHdl = liftIOE (S.hIsOpen rHdl) >>= \case   True  -> return rHdl   False -> throwError "invalid HANDLE. not opened." @@ -468,7 +468,7 @@ -- | -- isReadableHdl :: S.Handle -> AppContext S.Handle-isReadableHdl rHdl = liftIO (S.hIsReadable rHdl) >>= \case+isReadableHdl rHdl = liftIOE (S.hIsReadable rHdl) >>= \case   True  -> return rHdl   False -> throwError "invalid HANDLE. not readable." @@ -476,7 +476,7 @@ -- | -- isNotEofHdl :: S.Handle -> AppContext S.Handle-isNotEofHdl rHdl = liftIO (S.hIsEOF rHdl) >>= \case+isNotEofHdl rHdl = liftIOE (S.hIsEOF rHdl) >>= \case   False -> return rHdl   True  -> throwError "invalid HANDLE. eof." @@ -517,4 +517,35 @@     errHdl :: E.SomeException -> IO (Either String a)     errHdl = return . Left . show ++-- |+--+rstrip :: String -> String+rstrip = T.unpack . T.stripEnd . T.pack+++-- |+--+strip :: String -> String+strip = T.unpack . T.strip . T.pack++-- |+--+replace :: String -> String -> String -> String+replace a b c = T.unpack $ T.replace (T.pack a) (T.pack b) (T.pack c)++-- |+--+split :: String -> String -> [String]+split a b = map T.unpack $ T.splitOn (T.pack a) (T.pack b)++-- |+--+join :: String -> [String] -> String+join a b = T.unpack $ T.intercalate (T.pack a) $ map T.pack b++-- |+--+startswith :: String -> String -> Bool+startswith a b = T.isPrefixOf (T.pack a) (T.pack b)