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

module Haskell.Debug.Adapter.State.Init.Launch where

import Control.Monad.IO.Class
import Control.Monad.Except
import Control.Monad.State
import Control.Concurrent
import Control.Lens
import Text.Parsec
import qualified Text.Read as R
import qualified System.Log.Logger as L
import qualified Data.ByteString.Lazy as LB
import qualified Data.List as L
import qualified Data.Version as V

import qualified Haskell.DAP as DAP
import qualified Haskell.Debug.Adapter.Utility as U
import qualified Haskell.Debug.Adapter.State.Utility as SU
import Haskell.Debug.Adapter.Type
import Haskell.Debug.Adapter.Constant
import qualified Haskell.Debug.Adapter.Logger as L
import qualified Haskell.Debug.Adapter.GHCi as P


-- |
--   Any errors should be critical. don't catch anything here.
--
instance StateActivityIF InitStateData DAP.LaunchRequest where
  action :: AppState InitStateData
-> Request LaunchRequest -> AppContext (Maybe StateTransit)
action AppState InitStateData
_ (LaunchRequest LaunchRequest
req) = do
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ErrMsg -> ErrMsg -> IO ()
L.debugM ErrMsg
_LOG_APP forall a b. (a -> b) -> a -> b
$ ErrMsg
"InitState LaunchRequest called. " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ErrMsg
show LaunchRequest
req
    LaunchRequest -> AppContext (Maybe StateTransit)
app LaunchRequest
req

-- |
--   @see https://github.com/Microsoft/vscode/issues/4902
--   @see https://microsoft.github.io/debug-adapter-protocol/overview
--
app :: DAP.LaunchRequest -> AppContext (Maybe StateTransit)
app :: LaunchRequest -> AppContext (Maybe StateTransit)
app LaunchRequest
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

  LaunchRequest -> StateT AppStores (ExceptT ErrMsg IO) ()
setUpConfig LaunchRequest
req
  LaunchRequest -> StateT AppStores (ExceptT ErrMsg IO) ()
setUpLogger LaunchRequest
req

  ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
U.sendStdoutEvent ErrMsg
"Configuration read.\n"
  ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
U.sendConsoleEvent ErrMsg
"Starting GHCi.\n"
  ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
U.sendErrorEvent ErrMsg
"Wait for a moment.\n\n"

  -- must start here. can not start in the entry of GHCiRun State.
  -- because there is a transition from DebugRun to GHCiRun.
  LaunchRequest -> StateT AppStores (ExceptT ErrMsg IO) ()
startGHCi LaunchRequest
req
  StateT AppStores (ExceptT ErrMsg IO) ()
setPrompt
  LaunchRequest -> StateT AppStores (ExceptT ErrMsg IO) ()
launchCmd LaunchRequest
req
  StateT AppStores (ExceptT ErrMsg IO) ()
setMainArgs
  StateT AppStores (ExceptT ErrMsg IO) ()
loadStarupFile

  -- dont send launch response here.
  -- it must send after configuration done response.
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \AppStores
s-> AppStores
s{_launchReqSeqAppStores :: Int
_launchReqSeqAppStores = LaunchRequest -> Int
DAP.seqLaunchRequest LaunchRequest
req}

  -- after initialized event, vscode send setBreak... and
  -- ConfigurationDone request.
  Int
initSeq <- AppContext Int
U.getIncreasedResponseSequence
  Response -> StateT AppStores (ExceptT ErrMsg IO) ()
U.addResponse forall a b. (a -> b) -> a -> b
$ InitializedEvent -> Response
InitializedEvent forall a b. (a -> b) -> a -> b
$ InitializedEvent
DAP.defaultInitializedEvent {seqInitializedEvent :: Int
DAP.seqInitializedEvent = Int
initSeq}

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just StateTransit
Init_GHCiRun

  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 :: LaunchResponse
res = LaunchResponse
DAP.defaultLaunchResponse {
                seqLaunchResponse :: Int
DAP.seqLaunchResponse = Int
resSeq
              , request_seqLaunchResponse :: Int
DAP.request_seqLaunchResponse = LaunchRequest -> Int
DAP.seqLaunchRequest LaunchRequest
req
              , successLaunchResponse :: Bool
DAP.successLaunchResponse = Bool
False
              , messageLaunchResponse :: ErrMsg
DAP.messageLaunchResponse = ErrMsg
msg
              }

      Response -> StateT AppStores (ExceptT ErrMsg IO) ()
U.addResponse forall a b. (a -> b) -> a -> b
$ LaunchResponse -> Response
LaunchResponse LaunchResponse
res
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing


-- |
--
setUpConfig :: DAP.LaunchRequest -> AppContext ()
setUpConfig :: LaunchRequest -> StateT AppStores (ExceptT ErrMsg IO) ()
setUpConfig LaunchRequest
req = do
  let args :: LaunchRequestArguments
args = LaunchRequest -> LaunchRequestArguments
DAP.argumentsLaunchRequest LaunchRequest
req
  AppStores
appStores <- forall s (m :: * -> *). MonadState s m => m s
get

  let wsMVar :: MVar ErrMsg
wsMVar = AppStores
appStoresforall s a. s -> Getting a s a -> a
^.Lens' AppStores (MVar ErrMsg)
workspaceAppStores
      ws :: ErrMsg
ws = LaunchRequestArguments -> ErrMsg
DAP.workspaceLaunchRequestArguments LaunchRequestArguments
args
  ErrMsg
_ <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
takeMVar MVar ErrMsg
wsMVar
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar ErrMsg
wsMVar ErrMsg
ws
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ErrMsg -> ErrMsg -> IO ()
L.debugM ErrMsg
_LOG_APP forall a b. (a -> b) -> a -> b
$ ErrMsg
"workspace is " forall a. [a] -> [a] -> [a]
++ ErrMsg
ws

  let logPRMVar :: MVar Priority
logPRMVar = AppStores
appStoresforall s a. s -> Getting a s a -> a
^.Lens' AppStores (MVar Priority)
logPriorityAppStores
  Priority
logPR <- ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) Priority
getLogPriority forall a b. (a -> b) -> a -> b
$ LaunchRequestArguments -> ErrMsg
DAP.logLevelLaunchRequestArguments LaunchRequestArguments
args
  Priority
_ <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
takeMVar MVar Priority
logPRMVar
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar Priority
logPRMVar Priority
logPR

  forall s (m :: * -> *). MonadState s m => s -> m ()
put AppStores
appStores {
      _startupAppStores :: ErrMsg
_startupAppStores     = ErrMsg -> ErrMsg -> ErrMsg -> ErrMsg
U.replace [Char
_SEP_WIN] [Char
_SEP_UNIX] (LaunchRequestArguments -> ErrMsg
DAP.startupLaunchRequestArguments LaunchRequestArguments
args)
    , _startupFuncAppStores :: ErrMsg
_startupFuncAppStores = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ErrMsg
"" (\ErrMsg
s->if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ErrMsg -> ErrMsg
U.strip ErrMsg
s) then ErrMsg
"" else  (ErrMsg -> ErrMsg
U.strip ErrMsg
s)) (LaunchRequestArguments -> Maybe ErrMsg
DAP.startupFuncLaunchRequestArguments LaunchRequestArguments
args)
    , _startupArgsAppStores :: ErrMsg
_startupArgsAppStores = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ErrMsg
"" (forall a. a -> a
id) (LaunchRequestArguments -> Maybe ErrMsg
DAP.startupArgsLaunchRequestArguments LaunchRequestArguments
args)
    , _stopOnEntryAppStores :: Bool
_stopOnEntryAppStores = LaunchRequestArguments -> Bool
DAP.stopOnEntryLaunchRequestArguments LaunchRequestArguments
args
    , _mainArgsAppStores :: ErrMsg
_mainArgsAppStores    = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ErrMsg
"" (forall a. a -> a
id) (LaunchRequestArguments -> Maybe ErrMsg
DAP.mainArgsLaunchRequestArguments LaunchRequestArguments
args)
    }

  where
    getLogPriority :: ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) Priority
getLogPriority ErrMsg
logPRStr = case forall a. Read a => ErrMsg -> Either ErrMsg a
R.readEither ErrMsg
logPRStr of
      Right Priority
lv -> forall (m :: * -> *) a. Monad m => a -> m a
return Priority
lv
      Left ErrMsg
err -> do
        ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
U.sendErrorEvent forall a b. (a -> b) -> a -> b
$ ErrMsg
"log priority is invalid. WARNING set. [" forall a. [a] -> [a] -> [a]
++ ErrMsg
err forall a. [a] -> [a] -> [a]
++ ErrMsg
"]\n"
        forall (m :: * -> *) a. Monad m => a -> m a
return Priority
L.WARNING

-- |
--
setUpLogger :: DAP.LaunchRequest -> AppContext ()
setUpLogger :: LaunchRequest -> StateT AppStores (ExceptT ErrMsg IO) ()
setUpLogger LaunchRequest
req = do
  let args :: LaunchRequestArguments
args = LaunchRequest -> LaunchRequestArguments
DAP.argumentsLaunchRequest LaunchRequest
req
  AppStores
ctx <- forall s (m :: * -> *). MonadState s m => m s
get
  Priority
logPR <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
readMVar forall a b. (a -> b) -> a -> b
$ AppStores
ctxforall s a. s -> Getting a s a -> a
^.Lens' AppStores (MVar Priority)
logPriorityAppStores

  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ErrMsg -> Priority -> IO ()
L.setUpLogger (LaunchRequestArguments -> ErrMsg
DAP.logFileLaunchRequestArguments LaunchRequestArguments
args) Priority
logPR


-- |
--
startGHCi :: DAP.LaunchRequest -> AppContext ()
startGHCi :: LaunchRequest -> StateT AppStores (ExceptT ErrMsg IO) ()
startGHCi LaunchRequest
req = do
  let args :: LaunchRequestArguments
args = LaunchRequest -> LaunchRequestArguments
DAP.argumentsLaunchRequest LaunchRequest
req
      initPmpt :: ErrMsg
initPmpt = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ErrMsg
_GHCI_PROMPT forall a. a -> a
id (LaunchRequestArguments -> Maybe ErrMsg
DAP.ghciInitialPromptLaunchRequestArguments LaunchRequestArguments
args)
      envs :: Map ErrMsg ErrMsg
envs = LaunchRequestArguments -> Map ErrMsg ErrMsg
DAP.ghciEnvLaunchRequestArguments LaunchRequestArguments
args
      cmdStr :: ErrMsg
cmdStr = LaunchRequestArguments -> ErrMsg
DAP.ghciCmdLaunchRequestArguments LaunchRequestArguments
args
      cmdList :: [ErrMsg]
cmdList = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall a b. (a -> b) -> a -> b
$ ErrMsg -> ErrMsg -> [ErrMsg]
U.split ErrMsg
" " ErrMsg
cmdStr
      cmd :: ErrMsg
cmd  = forall a. [a] -> a
head [ErrMsg]
cmdList

  ErrMsg -> ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
U.debugEV ErrMsg
_LOG_APP forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> ErrMsg
show [ErrMsg]
cmdList

  [ErrMsg]
opts <- [ErrMsg] -> AppContext [ErrMsg]
addWithGHC (forall a. [a] -> [a]
tail [ErrMsg]
cmdList)

  AppStores
appStores <- forall s (m :: * -> *). MonadState s m => m s
get
  ErrMsg
cwd <- forall a. IO a -> AppContext a
U.liftIOE forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
readMVar forall a b. (a -> b) -> a -> b
$ AppStores
appStoresforall s a. s -> Getting a s a -> a
^.Lens' AppStores (MVar ErrMsg)
workspaceAppStores

  forall a. IO a -> AppContext a
U.liftIOE forall a b. (a -> b) -> a -> b
$ ErrMsg -> ErrMsg -> IO ()
L.debugM ErrMsg
_LOG_APP forall a b. (a -> b) -> a -> b
$ ErrMsg
"ghci initial prompt [" forall a. [a] -> [a] -> [a]
++ ErrMsg
initPmpt forall a. [a] -> [a] -> [a]
++ ErrMsg
"]."

  ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
U.sendConsoleEventLF forall a b. (a -> b) -> a -> b
$ ErrMsg
"CWD: " forall a. [a] -> [a] -> [a]
++ ErrMsg
cwd
  ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
U.sendConsoleEventLF forall a b. (a -> b) -> a -> b
$ ErrMsg
"CMD: " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
L.intercalate ErrMsg
" " (ErrMsg
cmd forall a. a -> [a] -> [a]
: [ErrMsg]
opts)
  ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
U.sendConsoleEventLF ErrMsg
""

  ErrMsg
-> [ErrMsg]
-> ErrMsg
-> Map ErrMsg ErrMsg
-> StateT AppStores (ExceptT ErrMsg IO) ()
P.startGHCi ErrMsg
cmd [ErrMsg]
opts ErrMsg
cwd Map ErrMsg ErrMsg
envs
  ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
U.sendErrorEventLF forall a b. (a -> b) -> a -> b
$ ErrMsg
"Now, waiting for an initial prompt(\""forall a. [a] -> [a] -> [a]
++ErrMsg
initPmptforall a. [a] -> [a] -> [a]
++ErrMsg
"\")" forall a. [a] -> [a] -> [a]
++ ErrMsg
" from ghci."
  ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
U.sendConsoleEventLF ErrMsg
""
  [ErrMsg]
res <- ErrMsg -> AppContext [ErrMsg]
P.expectInitPmpt ErrMsg
initPmpt

  [ErrMsg] -> StateT AppStores (ExceptT ErrMsg IO) ()
updateGHCiVersion [ErrMsg]
res

  where

    updateGHCiVersion :: [ErrMsg] -> StateT AppStores (ExceptT ErrMsg IO) ()
updateGHCiVersion [ErrMsg]
acc = case forall s t a.
Stream s Identity t =>
Parsec s () a -> ErrMsg -> s -> Either ParseError a
parse forall {u}. ParsecT ErrMsg u Identity Version
verParser ErrMsg
"getGHCiVersion" ([ErrMsg] -> ErrMsg
unlines [ErrMsg]
acc) of
      Right Version
v -> do
        ErrMsg -> ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
U.debugEV ErrMsg
_LOG_APP forall a b. (a -> b) -> a -> b
$ ErrMsg
"GHCi version is " forall a. [a] -> [a] -> [a]
++ Version -> ErrMsg
V.showVersion Version
v
        Version -> StateT AppStores (ExceptT ErrMsg IO) ()
updateGHCiVersion' Version
v
      Left ParseError
e  -> do
        ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
U.sendConsoleEventLF forall a b. (a -> b) -> a -> b
$ ErrMsg
"Can not parse ghci version. [" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ErrMsg
show ParseError
e forall a. [a] -> [a] -> [a]
++ ErrMsg
"]. Assumes "  forall a. [a] -> [a] -> [a]
++ Version -> ErrMsg
V.showVersion Version
_BASE_GHCI_VERSION forall a. [a] -> [a] -> [a]
++ ErrMsg
"."
        Version -> StateT AppStores (ExceptT ErrMsg IO) ()
updateGHCiVersion' Version
_BASE_GHCI_VERSION

    verParser :: ParsecT ErrMsg u Identity Version
verParser = do
      ErrMsg
_ <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
ErrMsg -> ParsecT s u m ErrMsg
string ErrMsg
"GHCi, version "))
      ErrMsg
v1 <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.')
      ErrMsg
v2 <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.')
      ErrMsg
v3 <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':')
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Int] -> Version
V.makeVersion [forall a. Read a => ErrMsg -> a
read ErrMsg
v1, forall a. Read a => ErrMsg -> a
read ErrMsg
v2, forall a. Read a => ErrMsg -> a
read ErrMsg
v3]

    updateGHCiVersion' :: Version -> StateT AppStores (ExceptT ErrMsg IO) ()
updateGHCiVersion' Version
v = do
      MVar Version
mver <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' AppStores (MVar Version)
ghciVerAppStores 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 b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar Version
mver Version
v

-- |
--
setPrompt :: AppContext ()
setPrompt :: StateT AppStores (ExceptT ErrMsg IO) ()
setPrompt = do
  ErrMsg
p <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' AppStores ErrMsg
ghciPmptAppStores forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
  let pmpt :: ErrMsg
pmpt = ErrMsg
_DAP_CMD_END2 forall a. [a] -> [a] -> [a]
++ ErrMsg
"\\n" forall a. [a] -> [a] -> [a]
++ ErrMsg
p
      cmd :: ErrMsg
cmd  = ErrMsg
":set prompt \""forall a. [a] -> [a] -> [a]
++ErrMsg
pmptforall a. [a] -> [a] -> [a]
++ErrMsg
"\""
      cmd2 :: ErrMsg
cmd2 = ErrMsg
":set prompt-cont \""forall a. [a] -> [a] -> [a]
++ErrMsg
pmptforall a. [a] -> [a] -> [a]
++ErrMsg
"\""

  ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
P.command ErrMsg
cmd
  AppContext [ErrMsg]
P.expectPmpt

  ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
P.command ErrMsg
cmd2
  AppContext [ErrMsg]
P.expectPmpt

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

-- |
--
launchCmd :: DAP.LaunchRequest -> AppContext ()
launchCmd :: LaunchRequest -> StateT AppStores (ExceptT ErrMsg IO) ()
launchCmd LaunchRequest
req = do
  let args :: LaunchRequestArguments
args = LaunchRequest -> LaunchRequestArguments
DAP.argumentsLaunchRequest LaunchRequest
req
      dap :: ErrMsg
dap = ErrMsg
":dap-launch "
      cmd :: ErrMsg
cmd = ErrMsg
dap forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ErrMsg
U.showDAP LaunchRequestArguments
args
      dbg :: ErrMsg
dbg = ErrMsg
dap forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ErrMsg
show LaunchRequestArguments
args

  ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
P.command ErrMsg
cmd
  ErrMsg -> ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
U.debugEV ErrMsg
_LOG_APP ErrMsg
dbg
  AppContext [ErrMsg]
P.expectPmpt

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


-- |
--
setMainArgs :: AppContext ()
setMainArgs :: StateT AppStores (ExceptT ErrMsg IO) ()
setMainArgs = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' AppStores ErrMsg
mainArgsAppStores forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  [] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  ErrMsg
args -> do
    let cmd :: ErrMsg
cmd  = ErrMsg
":set args "forall a. [a] -> [a] -> [a]
++ErrMsg
args

    ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
P.command ErrMsg
cmd
    AppContext [ErrMsg]
P.expectPmpt

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


-- |
--
loadStarupFile :: AppContext ()
loadStarupFile :: StateT AppStores (ExceptT ErrMsg IO) ()
loadStarupFile = do
  ErrMsg
file <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' AppStores ErrMsg
startupAppStores forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
  ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
SU.loadHsFile ErrMsg
file

  let cmd :: ErrMsg
cmd  = ErrMsg
":dap-context-modules "

  ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
P.command ErrMsg
cmd
  AppContext [ErrMsg]
P.expectPmpt

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


-- |
--
addWithGHC :: [String] -> AppContext [String]
addWithGHC :: [ErrMsg] -> AppContext [ErrMsg]
addWithGHC [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
addWithGHC [ErrMsg]
cmds
  | forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
L.elem ErrMsg
"--with-ghc=haskell-dap" [ErrMsg]
cmds = do
    ErrMsg -> ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
U.infoEV ErrMsg
_LOG_APP ErrMsg
"can not use haskell-dap. deleting \"--with-ghc=haskell-dap\""
    [ErrMsg] -> AppContext [ErrMsg]
addWithGHC forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> [a]
L.delete ErrMsg
"--with-ghc=haskell-dap" [ErrMsg]
cmds
  | [ErrMsg] -> Bool
withGhciExists [ErrMsg]
cmds = forall (m :: * -> *) a. Monad m => a -> m a
return [ErrMsg]
cmds
  | ErrMsg
"ghci" forall a. Eq a => a -> a -> Bool
== forall a. [a] -> a
head [ErrMsg]
cmds = do
    ErrMsg -> ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
U.infoEV ErrMsg
_LOG_APP ErrMsg
"\"--with-ghc\" option not found. adding \"--with-ghc=ghci-dap\""
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [ErrMsg]
cmdsforall a. a -> [a] -> [a]
:ErrMsg
"--with-ghc=ghci-dap"forall a. a -> [a] -> [a]
:forall a. [a] -> [a]
tail [ErrMsg]
cmds
  | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return [ErrMsg]
cmds
  where
    withGhciExists :: [ErrMsg] -> Bool
withGhciExists [] = Bool
False
    withGhciExists (ErrMsg
x:[ErrMsg]
xs)
      | forall a. Eq a => [a] -> [a] -> Bool
L.isPrefixOf ErrMsg
"--with-ghc=" ErrMsg
x = Bool
True
      | Bool
otherwise = [ErrMsg] -> Bool
withGhciExists [ErrMsg]
xs


-- |
--
_TASKS_JSON_FILE_CONTENTS :: LB.ByteString
_TASKS_JSON_FILE_CONTENTS :: ByteString
_TASKS_JSON_FILE_CONTENTS = ErrMsg -> ByteString
U.str2lbs forall a b. (a -> b) -> a -> b
$ ErrMsg -> [ErrMsg] -> ErrMsg
U.join ErrMsg
"\n" forall a b. (a -> b) -> a -> b
$
  [
    ErrMsg
"{"
  , ErrMsg
"  // atuomatically created by phoityne-vscode"
  , ErrMsg
"  "
  , ErrMsg
"  \"version\": \"2.0.0\","
  , ErrMsg
"  \"presentation\": {"
  , ErrMsg
"    \"reveal\": \"always\","
  , ErrMsg
"    \"panel\": \"new\""
  , ErrMsg
"  },"
  , ErrMsg
"  \"tasks\": ["
  , ErrMsg
"    {"
  , ErrMsg
"      \"group\": {"
  , ErrMsg
"        \"kind\": \"build\","
  , ErrMsg
"        \"isDefault\": true"
  , ErrMsg
"      },"
  , ErrMsg
"      \"label\": \"stack build\","
  , ErrMsg
"      \"type\": \"shell\","
  , ErrMsg
"      \"command\": \"echo START_STACK_BUILD && cd ${workspaceRoot} && stack build && echo END_STACK_BUILD \""
  , ErrMsg
"    },"
  , ErrMsg
"    { "
  , ErrMsg
"      \"group\": \"build\","
  , ErrMsg
"      \"type\": \"shell\","
  , ErrMsg
"      \"label\": \"stack clean & build\","
  , ErrMsg
"      \"command\": \"echo START_STACK_CLEAN_AND_BUILD && cd ${workspaceRoot} && stack clean && stack build && echo END_STACK_CLEAN_AND_BUILD \""
  , ErrMsg
"    },"
  , ErrMsg
"    { "
  , ErrMsg
"      \"group\": {"
  , ErrMsg
"        \"kind\": \"test\","
  , ErrMsg
"        \"isDefault\": true"
  , ErrMsg
"      },"
  , ErrMsg
"      \"type\": \"shell\","
  , ErrMsg
"      \"label\": \"stack test\","
  , ErrMsg
"      \"command\": \"echo START_STACK_TEST && cd ${workspaceRoot} && stack test && echo END_STACK_TEST \""
  , ErrMsg
"    },"
  , ErrMsg
"    { "
  , ErrMsg
"      \"isBackground\": true,"
  , ErrMsg
"      \"type\": \"shell\","
  , ErrMsg
"      \"label\": \"stack watch\","
  , ErrMsg
"      \"command\": \"echo START_STACK_WATCH && cd ${workspaceRoot} && stack build --test --no-run-tests --file-watch && echo END_STACK_WATCH \""
  , ErrMsg
"    }"
  , ErrMsg
"  ]"
  , ErrMsg
"}"
  ]