{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Haskell.Debug.Adapter.State.Utility where

import qualified System.Log.Logger as L
import qualified Text.Read as R
import Control.Monad.Except
import Control.Lens
import Control.Monad.State.Lazy
import Control.Concurrent.MVar

import qualified Haskell.DAP as DAP
import Haskell.Debug.Adapter.Type
import Haskell.Debug.Adapter.Constant
import qualified Haskell.Debug.Adapter.Utility as U
import qualified Haskell.Debug.Adapter.GHCi as P


-- |
--
setBreakpointsRequest :: DAP.SetBreakpointsRequest -> AppContext (Maybe StateTransit)
setBreakpointsRequest :: SetBreakpointsRequest -> AppContext (Maybe StateTransit)
setBreakpointsRequest SetBreakpointsRequest
req = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ErrMsg -> AppContext (Maybe StateTransit)
errHdl forall a b. (a -> b) -> a -> b
$ do
  let args :: SetBreakpointsRequestArguments
args = SetBreakpointsRequest -> SetBreakpointsRequestArguments
DAP.argumentsSetBreakpointsRequest SetBreakpointsRequest
req
      dap :: ErrMsg
dap = ErrMsg
":dap-set-breakpoints "
      cmd :: ErrMsg
cmd = ErrMsg
dap forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ErrMsg
U.showDAP SetBreakpointsRequestArguments
args
      dbg :: ErrMsg
dbg = ErrMsg
dap forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ErrMsg
show SetBreakpointsRequestArguments
args

  ErrMsg -> AppContext ()
P.command ErrMsg
cmd
  ErrMsg -> ErrMsg -> AppContext ()
U.debugEV ErrMsg
_LOG_APP ErrMsg
dbg
  AppContext [ErrMsg]
P.expectPmpt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ErrMsg] -> StateT AppStores (ExceptT ErrMsg IO) ErrMsg
takeDapResult forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ErrMsg -> AppContext ()
dapHdl

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

  where
    -- |
    --
    dapHdl :: String -> AppContext ()
    dapHdl :: ErrMsg -> AppContext ()
dapHdl ErrMsg
str = case forall a. Read a => ErrMsg -> Either ErrMsg a
R.readEither ErrMsg
str of
      Left ErrMsg
err -> ErrMsg -> AppContext (Maybe StateTransit)
errHdl ErrMsg
err forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Right (Left ErrMsg
err) -> ErrMsg -> AppContext (Maybe StateTransit)
errHdl ErrMsg
err forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Right (Right SetBreakpointsResponseBody
body) -> do
        Int
resSeq <- AppContext Int
U.getIncreasedResponseSequence
        let res :: SetBreakpointsResponse
res = SetBreakpointsResponse
DAP.defaultSetBreakpointsResponse {
                  seqSetBreakpointsResponse :: Int
DAP.seqSetBreakpointsResponse = Int
resSeq
                , request_seqSetBreakpointsResponse :: Int
DAP.request_seqSetBreakpointsResponse = SetBreakpointsRequest -> Int
DAP.seqSetBreakpointsRequest SetBreakpointsRequest
req
                , successSetBreakpointsResponse :: Bool
DAP.successSetBreakpointsResponse = Bool
True
                , bodySetBreakpointsResponse :: SetBreakpointsResponseBody
DAP.bodySetBreakpointsResponse = SetBreakpointsResponseBody
body
                }

        Response -> AppContext ()
U.addResponse forall a b. (a -> b) -> a -> b
$ SetBreakpointsResponse -> Response
SetBreakpointsResponse SetBreakpointsResponse
res

    -- |
    --
    errHdl :: String -> AppContext (Maybe StateTransit)
    errHdl :: ErrMsg -> AppContext (Maybe StateTransit)
errHdl ErrMsg
msg = do
      ErrMsg -> ErrMsg -> AppContext ()
U.errorEV ErrMsg
_LOG_APP ErrMsg
msg
      Int
resSeq <- AppContext Int
U.getIncreasedResponseSequence
      let res :: SetBreakpointsResponse
res = SetBreakpointsResponse
DAP.defaultSetBreakpointsResponse {
                seqSetBreakpointsResponse :: Int
DAP.seqSetBreakpointsResponse = Int
resSeq
              , request_seqSetBreakpointsResponse :: Int
DAP.request_seqSetBreakpointsResponse = SetBreakpointsRequest -> Int
DAP.seqSetBreakpointsRequest SetBreakpointsRequest
req
              , successSetBreakpointsResponse :: Bool
DAP.successSetBreakpointsResponse = Bool
False
              , messageSetBreakpointsResponse :: ErrMsg
DAP.messageSetBreakpointsResponse = ErrMsg
msg
              }

      Response -> AppContext ()
U.addResponse forall a b. (a -> b) -> a -> b
$ SetBreakpointsResponse -> Response
SetBreakpointsResponse SetBreakpointsResponse
res
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing


-- |
--
setExceptionBreakpointsRequest :: DAP.SetExceptionBreakpointsRequest -> AppContext (Maybe StateTransit)
setExceptionBreakpointsRequest :: SetExceptionBreakpointsRequest -> AppContext (Maybe StateTransit)
setExceptionBreakpointsRequest SetExceptionBreakpointsRequest
req = do
  let args :: SetExceptionBreakpointsRequestArguments
args = SetExceptionBreakpointsRequest
-> SetExceptionBreakpointsRequestArguments
DAP.argumentsSetExceptionBreakpointsRequest SetExceptionBreakpointsRequest
req
      filters :: [ErrMsg]
filters = SetExceptionBreakpointsRequestArguments -> [ErrMsg]
DAP.filtersSetExceptionBreakpointsRequestArguments SetExceptionBreakpointsRequestArguments
args

  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ErrMsg -> AppContext [ErrMsg]
go forall a b. (a -> b) -> a -> b
$ [ErrMsg] -> [ErrMsg]
getOptions [ErrMsg]
filters

  Int
resSeq <- AppContext Int
U.getIncreasedResponseSequence
  let res :: SetExceptionBreakpointsResponse
res = SetExceptionBreakpointsResponse
DAP.defaultSetExceptionBreakpointsResponse {
            seqSetExceptionBreakpointsResponse :: Int
DAP.seqSetExceptionBreakpointsResponse = Int
resSeq
          , request_seqSetExceptionBreakpointsResponse :: Int
DAP.request_seqSetExceptionBreakpointsResponse = SetExceptionBreakpointsRequest -> Int
DAP.seqSetExceptionBreakpointsRequest SetExceptionBreakpointsRequest
req
          , successSetExceptionBreakpointsResponse :: Bool
DAP.successSetExceptionBreakpointsResponse = Bool
True
          }

  Response -> AppContext ()
U.addResponse forall a b. (a -> b) -> a -> b
$ SetExceptionBreakpointsResponse -> Response
SetExceptionBreakpointsResponse SetExceptionBreakpointsResponse
res

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

  where
    getOptions :: [ErrMsg] -> [ErrMsg]
getOptions [ErrMsg]
filters
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ErrMsg]
filters                      = [ErrMsg
"-fno-break-on-exception", ErrMsg
"-fno-break-on-error"]
      | [ErrMsg]
filters forall a. Eq a => a -> a -> Bool
== [ErrMsg
"break-on-error"]     = [ErrMsg
"-fno-break-on-exception", ErrMsg
"-fbreak-on-error"]
      | [ErrMsg]
filters forall a. Eq a => a -> a -> Bool
== [ErrMsg
"break-on-exception"] = [ErrMsg
"-fbreak-on-exception",    ErrMsg
"-fno-break-on-error"]
      | Bool
otherwise                         = [ErrMsg
"-fbreak-on-exception",    ErrMsg
"-fbreak-on-error" ]

    go :: ErrMsg -> AppContext [ErrMsg]
go ErrMsg
opt = do
      let cmd :: ErrMsg
cmd = ErrMsg
":set " forall a. [a] -> [a] -> [a]
++ ErrMsg
opt

      ErrMsg -> AppContext ()
P.command ErrMsg
cmd
      AppContext [ErrMsg]
P.expectPmpt



-- |
--
setFunctionBreakpointsRequest :: DAP.SetFunctionBreakpointsRequest -> AppContext (Maybe StateTransit)
setFunctionBreakpointsRequest :: SetFunctionBreakpointsRequest -> AppContext (Maybe StateTransit)
setFunctionBreakpointsRequest SetFunctionBreakpointsRequest
req = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ErrMsg -> AppContext (Maybe StateTransit)
errHdl forall a b. (a -> b) -> a -> b
$ do
  let args :: SetFunctionBreakpointsRequestArguments
args = SetFunctionBreakpointsRequest
-> SetFunctionBreakpointsRequestArguments
DAP.argumentsSetFunctionBreakpointsRequest SetFunctionBreakpointsRequest
req
      dap :: ErrMsg
dap = ErrMsg
":dap-set-function-breakpoints "
      cmd :: ErrMsg
cmd = ErrMsg
dap forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ErrMsg
U.showDAP SetFunctionBreakpointsRequestArguments
args
      dbg :: ErrMsg
dbg = ErrMsg
dap forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ErrMsg
show SetFunctionBreakpointsRequestArguments
args

  ErrMsg -> AppContext ()
P.command ErrMsg
cmd
  ErrMsg -> ErrMsg -> AppContext ()
U.debugEV ErrMsg
_LOG_APP ErrMsg
dbg
  AppContext [ErrMsg]
P.expectPmpt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ErrMsg] -> StateT AppStores (ExceptT ErrMsg IO) ErrMsg
takeDapResult forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ErrMsg -> AppContext ()
dapHdl

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

  where

    -- |
    --
    dapHdl :: String -> AppContext ()
    dapHdl :: ErrMsg -> AppContext ()
dapHdl ErrMsg
str = case forall a. Read a => ErrMsg -> Either ErrMsg a
R.readEither ErrMsg
str of
      Left ErrMsg
err -> ErrMsg -> AppContext (Maybe StateTransit)
errHdl ErrMsg
err forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Right (Left ErrMsg
err) -> ErrMsg -> AppContext (Maybe StateTransit)
errHdl ErrMsg
err forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Right (Right SetFunctionBreakpointsResponseBody
body) -> do
        Int
resSeq <- AppContext Int
U.getIncreasedResponseSequence
        let res :: SetFunctionBreakpointsResponse
res = SetFunctionBreakpointsResponse
DAP.defaultSetFunctionBreakpointsResponse {
                  seqSetFunctionBreakpointsResponse :: Int
DAP.seqSetFunctionBreakpointsResponse = Int
resSeq
                , request_seqSetFunctionBreakpointsResponse :: Int
DAP.request_seqSetFunctionBreakpointsResponse = SetFunctionBreakpointsRequest -> Int
DAP.seqSetFunctionBreakpointsRequest SetFunctionBreakpointsRequest
req
                , successSetFunctionBreakpointsResponse :: Bool
DAP.successSetFunctionBreakpointsResponse = Bool
True
                , bodySetFunctionBreakpointsResponse :: SetFunctionBreakpointsResponseBody
DAP.bodySetFunctionBreakpointsResponse = SetFunctionBreakpointsResponseBody
body
                }

        Response -> AppContext ()
U.addResponse forall a b. (a -> b) -> a -> b
$ SetFunctionBreakpointsResponse -> Response
SetFunctionBreakpointsResponse SetFunctionBreakpointsResponse
res

    -- |
    --
    errHdl :: String -> AppContext (Maybe StateTransit)
    errHdl :: ErrMsg -> AppContext (Maybe StateTransit)
errHdl ErrMsg
msg = do
      ErrMsg -> ErrMsg -> AppContext ()
U.errorEV ErrMsg
_LOG_APP ErrMsg
msg
      Int
resSeq <- AppContext Int
U.getIncreasedResponseSequence
      let res :: SetFunctionBreakpointsResponse
res = SetFunctionBreakpointsResponse
DAP.defaultSetFunctionBreakpointsResponse {
                seqSetFunctionBreakpointsResponse :: Int
DAP.seqSetFunctionBreakpointsResponse = Int
resSeq
              , request_seqSetFunctionBreakpointsResponse :: Int
DAP.request_seqSetFunctionBreakpointsResponse = SetFunctionBreakpointsRequest -> Int
DAP.seqSetFunctionBreakpointsRequest SetFunctionBreakpointsRequest
req
              , successSetFunctionBreakpointsResponse :: Bool
DAP.successSetFunctionBreakpointsResponse = Bool
False
              , messageSetFunctionBreakpointsResponse :: ErrMsg
DAP.messageSetFunctionBreakpointsResponse = ErrMsg
msg
              }

      Response -> AppContext ()
U.addResponse forall a b. (a -> b) -> a -> b
$ SetFunctionBreakpointsResponse -> Response
SetFunctionBreakpointsResponse SetFunctionBreakpointsResponse
res
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing



-- |
--
terminateGHCi :: AppContext ()
terminateGHCi :: AppContext ()
terminateGHCi = do
  let cmd :: ErrMsg
cmd = ErrMsg
":quit"

  ErrMsg -> AppContext ()
P.command ErrMsg
cmd
  AppContext [ErrMsg]
P.expectPmpt
  forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- |
--
sendDisconnectResponse :: DAP.DisconnectRequest -> AppContext ()
sendDisconnectResponse :: DisconnectRequest -> AppContext ()
sendDisconnectResponse DisconnectRequest
req = do

  AppContext ()
tryTerminateGHCi

  Int
resSeq <- AppContext Int
U.getIncreasedResponseSequence

  let res :: DisconnectResponse
res = DisconnectResponse
DAP.defaultDisconnectResponse {
            seqDisconnectResponse :: Int
DAP.seqDisconnectResponse         = Int
resSeq
          , request_seqDisconnectResponse :: Int
DAP.request_seqDisconnectResponse = DisconnectRequest -> Int
DAP.seqDisconnectRequest DisconnectRequest
req
          , successDisconnectResponse :: Bool
DAP.successDisconnectResponse     = Bool
True
          }

  Response -> AppContext ()
U.addResponse forall a b. (a -> b) -> a -> b
$ DisconnectResponse -> Response
DisconnectResponse DisconnectResponse
res

  where
    tryTerminateGHCi :: AppContext ()
    tryTerminateGHCi :: AppContext ()
tryTerminateGHCi = do
      MVar GHCiProc
mver <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' AppStores (MVar GHCiProc)
ghciProcAppStores forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
      forall a. IO a -> AppContext a
U.liftIOE (forall a. MVar a -> IO Bool
isEmptyMVar MVar GHCiProc
mver) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Bool
False -> forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError AppContext ()
terminateGHCi (\ErrMsg
_->forall (m :: * -> *) a. Monad m => a -> m a
return ())


-- |
--
evaluateRequest :: DAP.EvaluateRequest -> AppContext (Maybe StateTransit)
evaluateRequest :: EvaluateRequest -> AppContext (Maybe StateTransit)
evaluateRequest EvaluateRequest
req = do

  let args :: EvaluateRequestArguments
args = EvaluateRequest -> EvaluateRequestArguments
DAP.argumentsEvaluateRequest EvaluateRequest
req
      dap :: ErrMsg
dap = ErrMsg
":dap-evaluate "
      cmd :: ErrMsg
cmd = ErrMsg
dap forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ErrMsg
U.showDAP EvaluateRequestArguments
args
      dbg :: ErrMsg
dbg = ErrMsg
dap forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ErrMsg
show EvaluateRequestArguments
args

  ErrMsg -> AppContext ()
P.command ErrMsg
cmd
  ErrMsg -> ErrMsg -> AppContext ()
U.debugEV ErrMsg
_LOG_APP ErrMsg
dbg
  AppContext [ErrMsg]
P.expectPmpt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ErrMsg] -> StateT AppStores (ExceptT ErrMsg IO) ErrMsg
takeDapResult forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ErrMsg -> AppContext ()
dapHdl

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

  where

    -- |
    --
    dapHdl :: String -> AppContext ()
    dapHdl :: ErrMsg -> AppContext ()
dapHdl ErrMsg
str = case forall a. Read a => ErrMsg -> Either ErrMsg a
R.readEither ErrMsg
str of
      Left ErrMsg
err -> ErrMsg -> AppContext ()
errHdl forall a b. (a -> b) -> a -> b
$ ErrMsg
err forall a. [a] -> [a] -> [a]
++ ErrMsg
" : " forall a. [a] -> [a] -> [a]
++ ErrMsg
str
      Right (Left ErrMsg
err) -> ErrMsg -> AppContext ()
errHdl ErrMsg
err
      Right (Right EvaluateResponseBody
body) -> do
        Int
resSeq <- AppContext Int
U.getIncreasedResponseSequence
        let res :: EvaluateResponse
res = EvaluateResponse
DAP.defaultEvaluateResponse {
                  seqEvaluateResponse :: Int
DAP.seqEvaluateResponse = Int
resSeq
                , request_seqEvaluateResponse :: Int
DAP.request_seqEvaluateResponse = EvaluateRequest -> Int
DAP.seqEvaluateRequest EvaluateRequest
req
                , successEvaluateResponse :: Bool
DAP.successEvaluateResponse = Bool
True
                , bodyEvaluateResponse :: EvaluateResponseBody
DAP.bodyEvaluateResponse = EvaluateResponseBody
body
                }

        Response -> AppContext ()
U.addResponse forall a b. (a -> b) -> a -> b
$ EvaluateResponse -> Response
EvaluateResponse EvaluateResponse
res


    -- |
    --
    errHdl :: String -> AppContext ()
    errHdl :: ErrMsg -> AppContext ()
errHdl ErrMsg
msg = do
      ErrMsg -> AppContext ()
U.sendErrorEventLF ErrMsg
msg
      Int
resSeq <- AppContext Int
U.getIncreasedResponseSequence
      let res :: EvaluateResponse
res = EvaluateResponse
DAP.defaultEvaluateResponse {
                seqEvaluateResponse :: Int
DAP.seqEvaluateResponse = Int
resSeq
              , request_seqEvaluateResponse :: Int
DAP.request_seqEvaluateResponse = EvaluateRequest -> Int
DAP.seqEvaluateRequest EvaluateRequest
req
              , successEvaluateResponse :: Bool
DAP.successEvaluateResponse = Bool
False
              , messageEvaluateResponse :: ErrMsg
DAP.messageEvaluateResponse = ErrMsg
msg
              }

      Response -> AppContext ()
U.addResponse forall a b. (a -> b) -> a -> b
$ EvaluateResponse -> Response
EvaluateResponse EvaluateResponse
res

-- |
--
completionsRequest :: DAP.CompletionsRequest -> AppContext (Maybe StateTransit)
completionsRequest :: CompletionsRequest -> AppContext (Maybe StateTransit)
completionsRequest CompletionsRequest
req = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ErrMsg -> AppContext (Maybe StateTransit)
errHdl forall a b. (a -> b) -> a -> b
$ do

  let args :: CompletionsRequestArguments
args = CompletionsRequest -> CompletionsRequestArguments
DAP.argumentsCompletionsRequest CompletionsRequest
req
      key :: ErrMsg
key  = CompletionsRequestArguments -> ErrMsg
DAP.textCompletionsRequestArguments CompletionsRequestArguments
args
      size :: ErrMsg
size = ErrMsg
"0-50"
      cmd :: ErrMsg
cmd = ErrMsg
":complete repl " forall a. [a] -> [a] -> [a]
++ ErrMsg
size forall a. [a] -> [a] -> [a]
++ ErrMsg
" \"" forall a. [a] -> [a] -> [a]
++ ErrMsg
key forall a. [a] -> [a] -> [a]
++ ErrMsg
"\""

  ErrMsg -> AppContext ()
P.command ErrMsg
cmd
  [ErrMsg]
outs <- AppContext [ErrMsg]
P.expectPmpt

  Int
resSeq <- AppContext Int
U.getIncreasedResponseSequence
  let items :: [CompletionsItem]
items = [ErrMsg] -> [CompletionsItem]
createItems [ErrMsg]
outs
      body :: CompletionsResponseBody
body  = CompletionsResponseBody
DAP.defaultCompletionsResponseBody {
              targetsCompletionsResponseBody :: [CompletionsItem]
DAP.targetsCompletionsResponseBody = [CompletionsItem]
items
            }
      res :: CompletionsResponse
res = CompletionsResponse
DAP.defaultCompletionsResponse {
            seqCompletionsResponse :: Int
DAP.seqCompletionsResponse = Int
resSeq
          , request_seqCompletionsResponse :: Int
DAP.request_seqCompletionsResponse = CompletionsRequest -> Int
DAP.seqCompletionsRequest CompletionsRequest
req
          , successCompletionsResponse :: Bool
DAP.successCompletionsResponse = Bool
True
          , bodyCompletionsResponse :: CompletionsResponseBody
DAP.bodyCompletionsResponse = CompletionsResponseBody
body
          }

  Response -> AppContext ()
U.addResponse forall a b. (a -> b) -> a -> b
$ CompletionsResponse -> Response
CompletionsResponse CompletionsResponse
res

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

  where
    -- |
    --
    errHdl :: String -> AppContext (Maybe StateTransit)
    errHdl :: ErrMsg -> AppContext (Maybe StateTransit)
errHdl ErrMsg
msg = do
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ErrMsg -> ErrMsg -> IO ()
L.errorM ErrMsg
_LOG_APP ErrMsg
msg
      Int
resSeq <- AppContext Int
U.getIncreasedResponseSequence
      let res :: CompletionsResponse
res = CompletionsResponse
DAP.defaultCompletionsResponse {
                seqCompletionsResponse :: Int
DAP.seqCompletionsResponse = Int
resSeq
              , request_seqCompletionsResponse :: Int
DAP.request_seqCompletionsResponse = CompletionsRequest -> Int
DAP.seqCompletionsRequest CompletionsRequest
req
              , successCompletionsResponse :: Bool
DAP.successCompletionsResponse = Bool
False
              , messageCompletionsResponse :: ErrMsg
DAP.messageCompletionsResponse = ErrMsg
msg
              }

      Response -> AppContext ()
U.addResponse forall a b. (a -> b) -> a -> b
$ CompletionsResponse -> Response
CompletionsResponse CompletionsResponse
res
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

    -- |
    --
    createItems :: [String] -> [DAP.CompletionsItem]
    createItems :: [ErrMsg] -> [CompletionsItem]
createItems = forall a b. (a -> b) -> [a] -> [b]
map (ErrMsg -> CompletionsItem
createItem forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrMsg -> ErrMsg
normalize) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ErrMsg] -> [ErrMsg]
extracCompleteList

    -- |
    --
    createItem :: String -> DAP.CompletionsItem
    createItem :: ErrMsg -> CompletionsItem
createItem (Char
':':ErrMsg
xs) = ErrMsg -> CompletionsItem
DAP.CompletionsItem ErrMsg
xs
    createItem ErrMsg
xs = ErrMsg -> CompletionsItem
DAP.CompletionsItem ErrMsg
xs

    -- |
    --
    normalize :: String -> String
    normalize :: ErrMsg -> ErrMsg
normalize ErrMsg
xs
      | Int
2 forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length ErrMsg
xs = forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ ErrMsg
xs
      | Bool
otherwise = ErrMsg
xs

    -- |
    --
    extracCompleteList :: [String] -> [String]
    extracCompleteList :: [ErrMsg] -> [ErrMsg]
extracCompleteList [] = []
    extracCompleteList (ErrMsg
_:[]) = []
    extracCompleteList (ErrMsg
_:ErrMsg
_:[]) = []
    extracCompleteList [ErrMsg]
xs = forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ [ErrMsg]
xs



-- |
--
loadHsFile :: FilePath -> AppContext ()
loadHsFile :: ErrMsg -> AppContext ()
loadHsFile ErrMsg
file = do
  let cmd :: ErrMsg
cmd  = ErrMsg
":load "forall a. [a] -> [a] -> [a]
++ ErrMsg
file

  ErrMsg -> AppContext ()
P.command ErrMsg
cmd
  AppContext [ErrMsg]
P.expectPmpt

  forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- |
--
terminateRequest :: DAP.TerminateRequest -> AppContext ()
terminateRequest :: TerminateRequest -> AppContext ()
terminateRequest TerminateRequest
req = do
  AppContext ()
terminateGHCi

  Int
resSeq <- AppContext Int
U.getIncreasedResponseSequence

  let res :: TerminateResponse
res = TerminateResponse
DAP.defaultTerminateResponse {
            seqTerminateResponse :: Int
DAP.seqTerminateResponse         = Int
resSeq
          , request_seqTerminateResponse :: Int
DAP.request_seqTerminateResponse = TerminateRequest -> Int
DAP.seqTerminateRequest TerminateRequest
req
          , successTerminateResponse :: Bool
DAP.successTerminateResponse     = Bool
True
          }

  Response -> AppContext ()
U.addResponse forall a b. (a -> b) -> a -> b
$ TerminateResponse -> Response
TerminateResponse TerminateResponse
res
  AppContext ()
U.sendTerminatedEvent
  AppContext ()
U.sendExitedEvent

-- |
--
internalTerminateRequest :: AppContext ()
internalTerminateRequest :: AppContext ()
internalTerminateRequest = do

    AppContext ()
terminateGHCi

    AppContext ()
U.sendTerminatedEvent
    AppContext ()
U.sendExitedEvent


-- |
--
takeDapResult :: [String] -> AppContext String
takeDapResult :: [ErrMsg] -> StateT AppStores (ExceptT ErrMsg IO) ErrMsg
takeDapResult [ErrMsg]
res = case forall a. (a -> Bool) -> [a] -> [a]
filter (ErrMsg -> ErrMsg -> Bool
U.startswith ErrMsg
_DAP_HEADER) [ErrMsg]
res of
  (ErrMsg
x:[]) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length ErrMsg
_DAP_HEADER) ErrMsg
x
  [ErrMsg]
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ ErrMsg
"invalid dap result from ghci. " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ErrMsg
show [ErrMsg]
res