{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}

module PMS.Infra.ProcSpawn.DS.Core where

import System.IO
import Control.Monad.Logger
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Lens
import Control.Monad.Reader
import qualified Control.Concurrent as CC 
import Control.Concurrent.Async
import qualified Control.Concurrent.STM as STM
import Data.Conduit
import qualified Data.Text as T
import Control.Monad.Except
import qualified Control.Exception.Safe as E
import System.Exit
import qualified Data.Text.Encoding as TE
import qualified Data.ByteString as BS
import Data.Aeson 
import qualified System.Process as S
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy.Char8 as BL

import qualified PMS.Domain.Model.DS.Utility as DM
import qualified PMS.Domain.Model.DM.Type as DM
import qualified PMS.Domain.Model.DM.Constant as DM

import PMS.Infra.ProcSpawn.DM.Type
import PMS.Infra.ProcSpawn.DS.Utility


-- |
--
app :: AppContext ()
app :: AppContext ()
app = do
  $Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG Text
"app called."
  ConduitT
  ()
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
-> AppContext ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit ConduitT
  ()
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
pipeline
  where
    pipeline :: ConduitM () Void AppContext ()
    pipeline :: ConduitT
  ()
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
pipeline = ConduitT
  ()
  ProcSpawnCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
src ConduitT
  ()
  ProcSpawnCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
-> ConduitT
     ProcSpawnCommand
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     ()
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT
  ProcSpawnCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
cmd2task ConduitT
  ProcSpawnCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     ProcSpawnCommand
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
sink

---------------------------------------------------------------------------------
-- |
--
src :: ConduitT () DM.ProcSpawnCommand AppContext ()
src :: ConduitT
  ()
  ProcSpawnCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
src = AppContext ProcSpawnCommand
-> ConduitT
     ()
     ProcSpawnCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ProcSpawnCommand
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT () ProcSpawnCommand m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift AppContext ProcSpawnCommand
go ConduitT
  ()
  ProcSpawnCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ProcSpawnCommand
-> (ProcSpawnCommand
    -> ConduitT
         ()
         ProcSpawnCommand
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         ())
-> ConduitT
     ()
     ProcSpawnCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b.
ConduitT
  ()
  ProcSpawnCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> (a
    -> ConduitT
         ()
         ProcSpawnCommand
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         b)
-> ConduitT
     ()
     ProcSpawnCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcSpawnCommand
-> ConduitT
     ()
     ProcSpawnCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ConduitT
  ()
  ProcSpawnCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
-> ConduitT
     ()
     ProcSpawnCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     ()
     ProcSpawnCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b.
ConduitT
  ()
  ProcSpawnCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> ConduitT
     ()
     ProcSpawnCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
-> ConduitT
     ()
     ProcSpawnCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT
  ()
  ProcSpawnCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
src
  where
    go :: AppContext DM.ProcSpawnCommand
    go :: AppContext ProcSpawnCommand
go = do
      TQueue ProcSpawnCommand
queue <- Getting
  (TQueue ProcSpawnCommand) DomainData (TQueue ProcSpawnCommand)
-> DomainData -> TQueue ProcSpawnCommand
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (TQueue ProcSpawnCommand) DomainData (TQueue ProcSpawnCommand)
Lens' DomainData (TQueue ProcSpawnCommand)
DM.procspawnQueueDomainData (DomainData -> TQueue ProcSpawnCommand)
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TQueue ProcSpawnCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
      ProcSpawnCommand
dat <- IO ProcSpawnCommand -> AppContext ProcSpawnCommand
forall a.
IO a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcSpawnCommand -> AppContext ProcSpawnCommand)
-> IO ProcSpawnCommand -> AppContext ProcSpawnCommand
forall a b. (a -> b) -> a -> b
$ STM ProcSpawnCommand -> IO ProcSpawnCommand
forall a. STM a -> IO a
STM.atomically (STM ProcSpawnCommand -> IO ProcSpawnCommand)
-> STM ProcSpawnCommand -> IO ProcSpawnCommand
forall a b. (a -> b) -> a -> b
$ TQueue ProcSpawnCommand -> STM ProcSpawnCommand
forall a. TQueue a -> STM a
STM.readTQueue TQueue ProcSpawnCommand
queue
      -- let jsonrpc = DM.getJsonRpcProcSpawnCommand dat
      
      ProcSpawnCommand -> AppContext ProcSpawnCommand
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return ProcSpawnCommand
dat

---------------------------------------------------------------------------------
-- |
--
cmd2task :: ConduitT DM.ProcSpawnCommand (IOTask ()) AppContext ()
cmd2task :: ConduitT
  ProcSpawnCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
cmd2task = ConduitT
  ProcSpawnCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  (Maybe ProcSpawnCommand)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT
  ProcSpawnCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  (Maybe ProcSpawnCommand)
-> (Maybe ProcSpawnCommand
    -> ConduitT
         ProcSpawnCommand
         (IOTask ())
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         ())
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b.
ConduitT
  ProcSpawnCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> (a
    -> ConduitT
         ProcSpawnCommand
         (IOTask ())
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         b)
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Just ProcSpawnCommand
cmd -> (ConduitT
   ProcSpawnCommand
   (IOTask ())
   (ReaderT
      AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
   ()
 -> ([Char]
     -> ConduitT
          ProcSpawnCommand
          (IOTask ())
          (ReaderT
             AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
          ())
 -> ConduitT
      ProcSpawnCommand
      (IOTask ())
      (ReaderT
         AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
      ())
-> ([Char]
    -> ConduitT
         ProcSpawnCommand
         (IOTask ())
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         ())
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ConduitT
  ProcSpawnCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
-> ([Char]
    -> ConduitT
         ProcSpawnCommand
         (IOTask ())
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         ())
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a.
ConduitT
  ProcSpawnCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> ([Char]
    -> ConduitT
         ProcSpawnCommand
         (IOTask ())
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         a)
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (ProcSpawnCommand
-> [Char]
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
errHdl ProcSpawnCommand
cmd) (ConduitT
   ProcSpawnCommand
   (IOTask ())
   (ReaderT
      AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
   ()
 -> ConduitT
      ProcSpawnCommand
      (IOTask ())
      (ReaderT
         AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
      ())
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ do
    AppContext (IOTask ())
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     (IOTask ())
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT ProcSpawnCommand (IOTask ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ProcSpawnCommand -> AppContext (IOTask ())
go ProcSpawnCommand
cmd) ConduitT
  ProcSpawnCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  (IOTask ())
-> (IOTask ()
    -> ConduitT
         ProcSpawnCommand
         (IOTask ())
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         ())
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b.
ConduitT
  ProcSpawnCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> (a
    -> ConduitT
         ProcSpawnCommand
         (IOTask ())
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         b)
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IOTask ()
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ConduitT
  ProcSpawnCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b.
ConduitT
  ProcSpawnCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT
  ProcSpawnCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
cmd2task
  Maybe ProcSpawnCommand
Nothing -> do
    $Text
-> Text
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
logWarnS Text
DM._LOGTAG Text
"cmd2task: await returns nothing. skip."
    ConduitT
  ProcSpawnCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
cmd2task

  where
    errHdl :: DM.ProcSpawnCommand -> String -> ConduitT DM.ProcSpawnCommand (IOTask ()) AppContext ()
    errHdl :: ProcSpawnCommand
-> [Char]
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
errHdl ProcSpawnCommand
procCmd [Char]
msg = do
      let jsonrpc :: JsonRpcRequest
jsonrpc = ProcSpawnCommand -> JsonRpcRequest
DM.getJsonRpcProcSpawnCommand ProcSpawnCommand
procCmd
      $Text
-> Text
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
logWarnS Text
DM._LOGTAG (Text
 -> ConduitT
      ProcSpawnCommand
      (IOTask ())
      (ReaderT
         AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
      ())
-> Text
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"cmd2task: exception occurred. skip. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg
      AppContext ()
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT ProcSpawnCommand (IOTask ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (AppContext ()
 -> ConduitT
      ProcSpawnCommand
      (IOTask ())
      (ReaderT
         AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
      ())
-> AppContext ()
-> ConduitT
     ProcSpawnCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ JsonRpcRequest -> [Char] -> AppContext ()
errorToolsCallResponse JsonRpcRequest
jsonrpc ([Char] -> AppContext ()) -> [Char] -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char]
"cmd2task: exception occurred. skip. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg
      ConduitT
  ProcSpawnCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
cmd2task

    go :: DM.ProcSpawnCommand -> AppContext (IOTask ())
    go :: ProcSpawnCommand -> AppContext (IOTask ())
go (DM.ProcEchoCommand ProcEchoCommandData
dat)      = ProcEchoCommandData -> AppContext (IOTask ())
genEchoTask ProcEchoCommandData
dat
    go (DM.ProcRunCommand ProcRunCommandData
dat)       = ProcRunCommandData -> AppContext (IOTask ())
genProcRunTask ProcRunCommandData
dat
    go (DM.ProcTerminateCommand ProcTerminateCommandData
dat) = ProcTerminateCommandData -> AppContext (IOTask ())
genProcTerminateTask ProcTerminateCommandData
dat
    go (DM.ProcMessageCommand ProcMessageCommandData
dat)   = ProcMessageCommandData -> AppContext (IOTask ())
genProcMessageTask ProcMessageCommandData
dat

---------------------------------------------------------------------------------
-- |
--
sink :: ConduitT (IOTask ()) Void AppContext ()
sink :: ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
sink = ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  (Maybe (IOTask ()))
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  (Maybe (IOTask ()))
-> (Maybe (IOTask ())
    -> ConduitT
         (IOTask ())
         Void
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         ())
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b.
ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> (a
    -> ConduitT
         (IOTask ())
         Void
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         b)
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Just IOTask ()
req -> (ConduitT
   (IOTask ())
   Void
   (ReaderT
      AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
   ()
 -> ([Char]
     -> ConduitT
          (IOTask ())
          Void
          (ReaderT
             AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
          ())
 -> ConduitT
      (IOTask ())
      Void
      (ReaderT
         AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
      ())
-> ([Char]
    -> ConduitT
         (IOTask ())
         Void
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         ())
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
-> ([Char]
    -> ConduitT
         (IOTask ())
         Void
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         ())
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a.
ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> ([Char]
    -> ConduitT
         (IOTask ())
         Void
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         a)
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError [Char]
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
errHdl (ConduitT
   (IOTask ())
   Void
   (ReaderT
      AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
   ()
 -> ConduitT
      (IOTask ())
      Void
      (ReaderT
         AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
      ())
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ do
    AppContext ()
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT (IOTask ()) Void m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOTask () -> AppContext ()
go IOTask ()
req) ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b.
ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
sink
  Maybe (IOTask ())
Nothing -> do
    $Text
-> Text
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
logWarnS Text
DM._LOGTAG Text
"sink: await returns nothing. skip."
    ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
sink

  where
    errHdl :: String -> ConduitT (IOTask ()) Void AppContext ()
    errHdl :: [Char]
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
errHdl [Char]
msg = do
      $Text
-> Text
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
logWarnS Text
DM._LOGTAG (Text
 -> ConduitT
      (IOTask ())
      Void
      (ReaderT
         AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
      ())
-> Text
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"sink: exception occurred. skip. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg
      ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
sink

    go :: (IO ()) -> AppContext ()
    go :: IOTask () -> AppContext ()
go IOTask ()
task = do
      $Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG Text
"sink: start async."
      Async ()
_ <- IO (Async ()) -> AppContext (Async ())
forall a.
IO a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
liftIOE (IO (Async ()) -> AppContext (Async ()))
-> IO (Async ()) -> AppContext (Async ())
forall a b. (a -> b) -> a -> b
$ IOTask () -> IO (Async ())
forall a. IO a -> IO (Async a)
async IOTask ()
task
      $Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG Text
"sink: end async."
      () -> AppContext ()
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


---------------------------------------------------------------------------------
-- |
--
genEchoTask :: DM.ProcEchoCommandData -> AppContext (IOTask ())
genEchoTask :: ProcEchoCommandData -> AppContext (IOTask ())
genEchoTask ProcEchoCommandData
dat = do
  TQueue McpResponse
resQ <- Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
-> DomainData -> TQueue McpResponse
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
Lens' DomainData (TQueue McpResponse)
DM.responseQueueDomainData (DomainData -> TQueue McpResponse)
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TQueue McpResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
  let val :: [Char]
val = ProcEchoCommandData
datProcEchoCommandData
-> Getting [Char] ProcEchoCommandData [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] ProcEchoCommandData [Char]
Lens' ProcEchoCommandData [Char]
DM.valueProcEchoCommandData

  $Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"echoTask: echo : " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
val
  IOTask () -> AppContext (IOTask ())
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOTask () -> AppContext (IOTask ()))
-> IOTask () -> AppContext (IOTask ())
forall a b. (a -> b) -> a -> b
$ TQueue McpResponse -> ProcEchoCommandData -> [Char] -> IOTask ()
echoTask TQueue McpResponse
resQ ProcEchoCommandData
dat [Char]
val


-- |
--
echoTask :: STM.TQueue DM.McpResponse -> DM.ProcEchoCommandData -> String -> IOTask ()
echoTask :: TQueue McpResponse -> ProcEchoCommandData -> [Char] -> IOTask ()
echoTask TQueue McpResponse
resQ ProcEchoCommandData
cmdDat [Char]
val = (IOTask () -> (SomeException -> IOTask ()) -> IOTask ())
-> (SomeException -> IOTask ()) -> IOTask () -> IOTask ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOTask () -> (SomeException -> IOTask ()) -> IOTask ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny SomeException -> IOTask ()
errHdl (IOTask () -> IOTask ()) -> IOTask () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ do
  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.ProcSpawn.DS.Core.echoTask run. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
val

  TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (ProcEchoCommandData
cmdDatProcEchoCommandData
-> Getting JsonRpcRequest ProcEchoCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest ProcEchoCommandData JsonRpcRequest
Lens' ProcEchoCommandData JsonRpcRequest
DM.jsonrpcProcEchoCommandData) ExitCode
ExitSuccess [Char]
val [Char]
""

  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[INFO] PMS.Infra.ProcSpawn.DS.Core.echoTask end."

  where
    errHdl :: E.SomeException -> IO ()
    errHdl :: SomeException -> IOTask ()
errHdl SomeException
e = TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (ProcEchoCommandData
cmdDatProcEchoCommandData
-> Getting JsonRpcRequest ProcEchoCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest ProcEchoCommandData JsonRpcRequest
Lens' ProcEchoCommandData JsonRpcRequest
DM.jsonrpcProcEchoCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)

-- |
--
genProcRunTask :: DM.ProcRunCommandData -> AppContext (IOTask ())
genProcRunTask :: ProcRunCommandData -> AppContext (IOTask ())
genProcRunTask ProcRunCommandData
cmdDat = case ProcRunCommandData
cmdDatProcRunCommandData
-> Getting [Char] ProcRunCommandData [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] ProcRunCommandData [Char]
Lens' ProcRunCommandData [Char]
DM.nameProcRunCommandData of
  [Char]
"proc-spawn"  -> ProcRunCommandData -> AppContext (IOTask ())
genProcSpawn ProcRunCommandData
cmdDat
  [Char]
"proc-ssh"    -> ProcRunCommandData -> AppContext (IOTask ())
genProcSpawn ProcRunCommandData
cmdDat
  [Char]
"proc-telnet" -> ProcRunCommandData -> AppContext (IOTask ())
genProcSpawn ProcRunCommandData
cmdDat
  [Char]
"proc-winpty" -> ProcRunCommandData -> AppContext (IOTask ())
genProcSpawn ProcRunCommandData
cmdDat
  [Char]
"proc-plink"  -> ProcRunCommandData -> AppContext (IOTask ())
genProcSpawn ProcRunCommandData
cmdDat
  [Char]
"proc-cmd"    -> ProcRunCommandData -> AppContext (IOTask ())
genProcCMD ProcRunCommandData
cmdDat
  [Char]
"proc-ps"     -> ProcRunCommandData -> AppContext (IOTask ())
genProcPS ProcRunCommandData
cmdDat
  [Char]
x -> [Char] -> AppContext (IOTask ())
forall a.
[Char]
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Char] -> AppContext (IOTask ()))
-> [Char] -> AppContext (IOTask ())
forall a b. (a -> b) -> a -> b
$ [Char]
"genProcRunTask: unsupported command. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x


-- |
--   
genProcSpawn :: DM.ProcRunCommandData -> AppContext (IOTask ())
genProcSpawn :: ProcRunCommandData -> AppContext (IOTask ())
genProcSpawn ProcRunCommandData
cmdDat = do
  let name :: [Char]
name     = ProcRunCommandData
cmdDatProcRunCommandData
-> Getting [Char] ProcRunCommandData [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] ProcRunCommandData [Char]
Lens' ProcRunCommandData [Char]
DM.nameProcRunCommandData
      argsBS :: ByteString
argsBS   = RawJsonByteString -> ByteString
DM.unRawJsonByteString (RawJsonByteString -> ByteString)
-> RawJsonByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ProcRunCommandData
cmdDatProcRunCommandData
-> Getting RawJsonByteString ProcRunCommandData RawJsonByteString
-> RawJsonByteString
forall s a. s -> Getting a s a -> a
^.Getting RawJsonByteString ProcRunCommandData RawJsonByteString
Lens' ProcRunCommandData RawJsonByteString
DM.argumentsProcRunCommandData
      tout :: Int
tout     = Int
DM._TIMEOUT_MICROSEC
      addEnv :: [([Char], [Char])]
addEnv   = [([Char]
"ProgramData", [Char]
"C:\\ProgramData"), ([Char]
"SystemRoot", [Char]
"C:\\Windows")] -- for windows ssh on claude code.

  [[Char]]
prompts   <- Getting [[Char]] DomainData [[Char]] -> DomainData -> [[Char]]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [[Char]] DomainData [[Char]]
Lens' DomainData [[Char]]
DM.promptsDomainData (DomainData -> [[Char]])
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TQueue McpResponse
resQ      <- Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
-> DomainData -> TQueue McpResponse
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
Lens' DomainData (TQueue McpResponse)
DM.responseQueueDomainData (DomainData -> TQueue McpResponse)
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TQueue McpResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TMVar (Maybe ProcData)
procMVar  <- Getting (TMVar (Maybe ProcData)) AppData (TMVar (Maybe ProcData))
-> AppData -> TMVar (Maybe ProcData)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar (Maybe ProcData)) AppData (TMVar (Maybe ProcData))
Lens' AppData (TMVar (Maybe ProcData))
processAppData (AppData -> TMVar (Maybe ProcData))
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TMVar (Maybe ProcData))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TMVar ()
lockTMVar <- Getting (TMVar ()) AppData (TMVar ()) -> AppData -> TMVar ()
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar ()) AppData (TMVar ())
Lens' AppData (TMVar ())
lockAppData (AppData -> TMVar ())
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TMVar ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask

  ([Char]
cmdTmp, [[Char]]
argsArrayTmp, [[Char]]
addPrompts)  <- [Char] -> ByteString -> AppContext ([Char], [[Char]], [[Char]])
getCommandArgs [Char]
name ByteString
argsBS
  [Char]
cmd <- IO [Char] -> AppContext [Char]
forall a.
IO a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
liftIOE (IO [Char] -> AppContext [Char]) -> IO [Char] -> AppContext [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
DM.validateCommand [Char]
cmdTmp
  [[Char]]
argsArray <- IO [[Char]]
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     [[Char]]
forall a.
IO a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
liftIOE (IO [[Char]]
 -> ReaderT
      AppData
      (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
      [[Char]])
-> IO [[Char]]
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> IO [[Char]]
DM.validateArgs [[Char]]
argsArrayTmp

  $Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"genProcRunTask: cmd. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cmd [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
argsArray
 
  IOTask () -> AppContext (IOTask ())
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOTask () -> AppContext (IOTask ()))
-> IOTask () -> AppContext (IOTask ())
forall a b. (a -> b) -> a -> b
$ ProcRunCommandData
-> TQueue McpResponse
-> TMVar (Maybe ProcData)
-> TMVar ()
-> [Char]
-> [[Char]]
-> [([Char], [Char])]
-> [[Char]]
-> Int
-> IOTask ()
procSpawnTask ProcRunCommandData
cmdDat TQueue McpResponse
resQ TMVar (Maybe ProcData)
procMVar TMVar ()
lockTMVar [Char]
cmd [[Char]]
argsArray [([Char], [Char])]
addEnv ([[Char]]
prompts[[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++[[Char]]
addPrompts) Int
tout

  where
    -- |
    --
    getCommandArgs :: String -> BL.ByteString -> AppContext (String, [String], [String])
    getCommandArgs :: [Char] -> ByteString -> AppContext ([Char], [[Char]], [[Char]])
getCommandArgs [Char]
"proc-spawn" ByteString
argsBS = do
      ProcCommandToolParams
argsDat <- Either [Char] ProcCommandToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     ProcCommandToolParams
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [Char] ProcCommandToolParams
 -> ReaderT
      AppData
      (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
      ProcCommandToolParams)
-> Either [Char] ProcCommandToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     ProcCommandToolParams
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] ProcCommandToolParams
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode (ByteString -> Either [Char] ProcCommandToolParams)
-> ByteString -> Either [Char] ProcCommandToolParams
forall a b. (a -> b) -> a -> b
$ ByteString
argsBS
      let argsArray :: [[Char]]
argsArray = [[Char]] -> ([[Char]] -> [[Char]]) -> Maybe [[Char]] -> [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [[Char]] -> [[Char]]
forall a. a -> a
id (ProcCommandToolParams
argsDatProcCommandToolParams
-> Getting (Maybe [[Char]]) ProcCommandToolParams (Maybe [[Char]])
-> Maybe [[Char]]
forall s a. s -> Getting a s a -> a
^.Getting (Maybe [[Char]]) ProcCommandToolParams (Maybe [[Char]])
Lens' ProcCommandToolParams (Maybe [[Char]])
argumentsProcCommandToolParams)
          cmd :: [Char]
cmd = ProcCommandToolParams
argsDatProcCommandToolParams
-> Getting [Char] ProcCommandToolParams [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] ProcCommandToolParams [Char]
Lens' ProcCommandToolParams [Char]
commandProcCommandToolParams
      ([Char], [[Char]], [[Char]])
-> AppContext ([Char], [[Char]], [[Char]])
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
cmd, [[Char]]
argsArray, [])

    getCommandArgs [Char]
"proc-ssh" ByteString
argsBS = do
      ProcStringArrayToolParams
argsDat <- Either [Char] ProcStringArrayToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     ProcStringArrayToolParams
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [Char] ProcStringArrayToolParams
 -> ReaderT
      AppData
      (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
      ProcStringArrayToolParams)
-> Either [Char] ProcStringArrayToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     ProcStringArrayToolParams
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] ProcStringArrayToolParams
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode (ByteString -> Either [Char] ProcStringArrayToolParams)
-> ByteString -> Either [Char] ProcStringArrayToolParams
forall a b. (a -> b) -> a -> b
$ ByteString
argsBS
      let argsArray0 :: [[Char]]
argsArray0 = ProcStringArrayToolParams
argsDat ProcStringArrayToolParams
-> Getting [[Char]] ProcStringArrayToolParams [[Char]] -> [[Char]]
forall s a. s -> Getting a s a -> a
^. Getting [[Char]] ProcStringArrayToolParams [[Char]]
Iso' ProcStringArrayToolParams [[Char]]
argumentsProcStringArrayToolParams
          argsArray :: [[Char]]
argsArray  = if [Char]
"-tt" [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
argsArray0 then [[Char]]
argsArray0 else [Char]
"-tt" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
argsArray0
      ([Char], [[Char]], [[Char]])
-> AppContext ([Char], [[Char]], [[Char]])
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
"ssh", [[Char]]
argsArray, [[Char]
")?", [Char]
"password:"])
      -- return ("ssh", ["-o", "LogLevel=DEBUG", "-v"] ++ argsArray, [")?", "password:"])

    getCommandArgs [Char]
"proc-telnet" ByteString
argsBS = do
      ProcStringArrayToolParams
argsDat <- Either [Char] ProcStringArrayToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     ProcStringArrayToolParams
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [Char] ProcStringArrayToolParams
 -> ReaderT
      AppData
      (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
      ProcStringArrayToolParams)
-> Either [Char] ProcStringArrayToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     ProcStringArrayToolParams
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] ProcStringArrayToolParams
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode (ByteString -> Either [Char] ProcStringArrayToolParams)
-> ByteString -> Either [Char] ProcStringArrayToolParams
forall a b. (a -> b) -> a -> b
$ ByteString
argsBS
      let argsArray :: [[Char]]
argsArray = ProcStringArrayToolParams
argsDatProcStringArrayToolParams
-> Getting [[Char]] ProcStringArrayToolParams [[Char]] -> [[Char]]
forall s a. s -> Getting a s a -> a
^.Getting [[Char]] ProcStringArrayToolParams [[Char]]
Iso' ProcStringArrayToolParams [[Char]]
argumentsProcStringArrayToolParams
          winpty :: [Char]
winpty = [Char]
"plink"
--          winpty = "C:\\Progra~1\\Git\\usr\\bin\\winpty.exe"
      ([Char], [[Char]], [[Char]])
-> AppContext ([Char], [[Char]], [[Char]])
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
winpty, [Char]
"-telnet"[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
argsArray, [[Char]
"login:", [Char]
"Password:"])

    getCommandArgs [Char]
"proc-winpty" ByteString
argsBS = do
      ProcStringArrayToolParams
argsDat <- Either [Char] ProcStringArrayToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     ProcStringArrayToolParams
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [Char] ProcStringArrayToolParams
 -> ReaderT
      AppData
      (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
      ProcStringArrayToolParams)
-> Either [Char] ProcStringArrayToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     ProcStringArrayToolParams
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] ProcStringArrayToolParams
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode (ByteString -> Either [Char] ProcStringArrayToolParams)
-> ByteString -> Either [Char] ProcStringArrayToolParams
forall a b. (a -> b) -> a -> b
$ ByteString
argsBS
      let argsArray :: [[Char]]
argsArray = ProcStringArrayToolParams
argsDatProcStringArrayToolParams
-> Getting [[Char]] ProcStringArrayToolParams [[Char]] -> [[Char]]
forall s a. s -> Getting a s a -> a
^.Getting [[Char]] ProcStringArrayToolParams [[Char]]
Iso' ProcStringArrayToolParams [[Char]]
argumentsProcStringArrayToolParams
          winpty :: [Char]
winpty = [Char]
"winpty"
          -- winpty = "C:\\Progra~1\\Git\\usr\\bin\\winpty.exe"
      ([Char], [[Char]], [[Char]])
-> AppContext ([Char], [[Char]], [[Char]])
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
winpty, [[Char]]
argsArray, [[Char]
"login:", [Char]
"Password:", [Char]
")?", [Char]
"password:"])

    getCommandArgs [Char]
"proc-plink" ByteString
argsBS = do
      ProcStringArrayToolParams
argsDat <- Either [Char] ProcStringArrayToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     ProcStringArrayToolParams
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [Char] ProcStringArrayToolParams
 -> ReaderT
      AppData
      (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
      ProcStringArrayToolParams)
-> Either [Char] ProcStringArrayToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     ProcStringArrayToolParams
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] ProcStringArrayToolParams
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode (ByteString -> Either [Char] ProcStringArrayToolParams)
-> ByteString -> Either [Char] ProcStringArrayToolParams
forall a b. (a -> b) -> a -> b
$ ByteString
argsBS
      let argsArray :: [[Char]]
argsArray = ProcStringArrayToolParams
argsDatProcStringArrayToolParams
-> Getting [[Char]] ProcStringArrayToolParams [[Char]] -> [[Char]]
forall s a. s -> Getting a s a -> a
^.Getting [[Char]] ProcStringArrayToolParams [[Char]]
Iso' ProcStringArrayToolParams [[Char]]
argumentsProcStringArrayToolParams
          plink :: [Char]
plink = [Char]
"plink"
          -- plink = "C:\\Progra~1\\PuTTY\\plink.exe"
      ([Char], [[Char]], [[Char]])
-> AppContext ([Char], [[Char]], [[Char]])
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
plink, [[Char]]
argsArray, [[Char]
"login:", [Char]
"Password:", [Char]
")?", [Char]
"password:"])

    getCommandArgs [Char]
x ByteString
_ = [Char] -> AppContext ([Char], [[Char]], [[Char]])
forall a.
[Char]
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Char] -> AppContext ([Char], [[Char]], [[Char]]))
-> [Char] -> AppContext ([Char], [[Char]], [[Char]])
forall a b. (a -> b) -> a -> b
$ [Char]
"getCommandArgs: unsupported command. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x


-- |
--   
procSpawnTask :: DM.ProcRunCommandData
              -> STM.TQueue DM.McpResponse
              -> STM.TMVar (Maybe ProcData)
              -> STM.TMVar ()
              -> String
              -> [String]
              -> [(String, String)]
              -> [String]
              -> Int
              -> IOTask ()
procSpawnTask :: ProcRunCommandData
-> TQueue McpResponse
-> TMVar (Maybe ProcData)
-> TMVar ()
-> [Char]
-> [[Char]]
-> [([Char], [Char])]
-> [[Char]]
-> Int
-> IOTask ()
procSpawnTask ProcRunCommandData
cmdDat TQueue McpResponse
resQ TMVar (Maybe ProcData)
procVar TMVar ()
lockTMVar [Char]
cmd [[Char]]
args [([Char], [Char])]
addEnv [[Char]]
prompts Int
tout = do
  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.ProcSpawn.DS.Core.procSpawnTask start. "

  STM (Maybe ProcData) -> IO (Maybe ProcData)
forall a. STM a -> IO a
STM.atomically (TMVar (Maybe ProcData) -> STM (Maybe ProcData)
forall a. TMVar a -> STM a
STM.takeTMVar TMVar (Maybe ProcData)
procVar) IO (Maybe ProcData) -> (Maybe ProcData -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just ProcData
p -> do
      STM () -> IOTask ()
forall a. STM a -> IO a
STM.atomically (STM () -> IOTask ()) -> STM () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ TMVar (Maybe ProcData) -> Maybe ProcData -> STM ()
forall a. TMVar a -> a -> STM ()
STM.putTMVar TMVar (Maybe ProcData)
procVar (Maybe ProcData -> STM ()) -> Maybe ProcData -> STM ()
forall a b. (a -> b) -> a -> b
$ ProcData -> Maybe ProcData
forall a. a -> Maybe a
Just ProcData
p
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[ERROR] PMS.Infrastructure.DS.Core.procSpawnTask: pms is already connected."
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (ProcRunCommandData
cmdDatProcRunCommandData
-> Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
Lens' ProcRunCommandData JsonRpcRequest
DM.jsonrpcProcRunCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"process is already running."
    Maybe ProcData
Nothing -> do
      (IOTask () -> (SomeException -> IOTask ()) -> IOTask ())
-> (SomeException -> IOTask ()) -> IOTask () -> IOTask ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOTask () -> (SomeException -> IOTask ()) -> IOTask ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny SomeException -> IOTask ()
errHdl (IOTask () -> IOTask ()) -> IOTask () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ TMVar (Maybe ProcData)
-> [Char] -> [[Char]] -> [([Char], [Char])] -> IOTask ()
runProc TMVar (Maybe ProcData)
procVar [Char]
cmd [[Char]]
args [([Char], [Char])]
addEnv

  STM (Maybe ProcData) -> IO (Maybe ProcData)
forall a. STM a -> IO a
STM.atomically (TMVar (Maybe ProcData) -> STM (Maybe ProcData)
forall a. TMVar a -> STM a
STM.readTMVar TMVar (Maybe ProcData)
procVar) IO (Maybe ProcData) -> (Maybe ProcData -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just ProcData
p -> do
      IO (Maybe [Char]) -> IOTask () -> IO (Either (Maybe [Char]) ())
forall a b. IO a -> IO b -> IO (Either a b)
race (TMVar () -> IO ByteString -> [[Char]] -> IO (Maybe [Char])
DM.expect TMVar ()
lockTMVar (ProcData -> IO ByteString
readProc ProcData
p) [[Char]]
prompts) (Int -> IOTask ()
CC.threadDelay Int
tout) IO (Either (Maybe [Char]) ())
-> (Either (Maybe [Char]) () -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left Maybe [Char]
res -> TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (ProcRunCommandData
cmdDatProcRunCommandData
-> Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
Lens' ProcRunCommandData JsonRpcRequest
DM.jsonrpcProcRunCommandData) ExitCode
ExitSuccess ([Char] -> ([Char] -> [Char]) -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"Nothing" [Char] -> [Char]
forall a. a -> a
id Maybe [Char]
res) [Char]
""
        Right ()
_  -> TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (ProcRunCommandData
cmdDatProcRunCommandData
-> Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
Lens' ProcRunCommandData JsonRpcRequest
DM.jsonrpcProcRunCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"timeout occurred."
    Maybe ProcData
Nothing -> do
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[ERROR] PMS.Infrastructure.DS.Core.procSpawnTask: unexpected. proc not found."
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (ProcRunCommandData
cmdDatProcRunCommandData
-> Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
Lens' ProcRunCommandData JsonRpcRequest
DM.jsonrpcProcRunCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"unexpected. proc not found."

  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[INFO] PMS.Infra.ProcSpawn.DS.Core.procSpawnTask end."

  where
    errHdl :: E.SomeException -> IO ()
    errHdl :: SomeException -> IOTask ()
errHdl SomeException
e = do
      STM () -> IOTask ()
forall a. STM a -> IO a
STM.atomically (STM () -> IOTask ()) -> STM () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ TMVar (Maybe ProcData) -> Maybe ProcData -> STM ()
forall a. TMVar a -> a -> STM ()
STM.putTMVar TMVar (Maybe ProcData)
procVar Maybe ProcData
forall a. Maybe a
Nothing
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[ERROR] PMS.Infra.ProcSpawn.DS.Core.procRunTask: exception occurred. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (ProcRunCommandData
cmdDatProcRunCommandData
-> Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
Lens' ProcRunCommandData JsonRpcRequest
DM.jsonrpcProcRunCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)


-- |
--   
genProcCMD :: DM.ProcRunCommandData -> AppContext (IOTask ())
genProcCMD :: ProcRunCommandData -> AppContext (IOTask ())
genProcCMD ProcRunCommandData
cmdDat = do
  $Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"genProcCMD: called. "

  let tout :: Int
tout = Int
DM._TIMEOUT_MICROSEC

  [[Char]]
prompts <- Getting [[Char]] DomainData [[Char]] -> DomainData -> [[Char]]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [[Char]] DomainData [[Char]]
Lens' DomainData [[Char]]
DM.promptsDomainData (DomainData -> [[Char]])
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TQueue McpResponse
resQ <- Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
-> DomainData -> TQueue McpResponse
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
Lens' DomainData (TQueue McpResponse)
DM.responseQueueDomainData (DomainData -> TQueue McpResponse)
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TQueue McpResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TMVar (Maybe ProcData)
procMVar <- Getting (TMVar (Maybe ProcData)) AppData (TMVar (Maybe ProcData))
-> AppData -> TMVar (Maybe ProcData)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar (Maybe ProcData)) AppData (TMVar (Maybe ProcData))
Lens' AppData (TMVar (Maybe ProcData))
processAppData (AppData -> TMVar (Maybe ProcData))
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TMVar (Maybe ProcData))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TMVar ()
lockTMVar <- Getting (TMVar ()) AppData (TMVar ()) -> AppData -> TMVar ()
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar ()) AppData (TMVar ())
Lens' AppData (TMVar ())
lockAppData (AppData -> TMVar ())
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TMVar ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask
  
  IOTask () -> AppContext (IOTask ())
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOTask () -> AppContext (IOTask ()))
-> IOTask () -> AppContext (IOTask ())
forall a b. (a -> b) -> a -> b
$ ProcRunCommandData
-> TQueue McpResponse
-> TMVar (Maybe ProcData)
-> TMVar ()
-> [[Char]]
-> Int
-> IOTask ()
genProcCMDTask ProcRunCommandData
cmdDat TQueue McpResponse
resQ TMVar (Maybe ProcData)
procMVar TMVar ()
lockTMVar [[Char]]
prompts Int
tout

-- |
--   
genProcCMDTask :: DM.ProcRunCommandData
               -> STM.TQueue DM.McpResponse
               -> STM.TMVar (Maybe ProcData)
               -> STM.TMVar ()
               -> [String]
               -> Int
               -> IOTask ()
genProcCMDTask :: ProcRunCommandData
-> TQueue McpResponse
-> TMVar (Maybe ProcData)
-> TMVar ()
-> [[Char]]
-> Int
-> IOTask ()
genProcCMDTask ProcRunCommandData
cmdDat TQueue McpResponse
resQ TMVar (Maybe ProcData)
procVar TMVar ()
lockTMVar [[Char]]
prompts Int
tout = (IOTask () -> (SomeException -> IOTask ()) -> IOTask ())
-> (SomeException -> IOTask ()) -> IOTask () -> IOTask ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOTask () -> (SomeException -> IOTask ()) -> IOTask ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny SomeException -> IOTask ()
errHdl (IOTask () -> IOTask ()) -> IOTask () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ do
  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.ProcSpawn.DS.Core.genProcCMDTask start. "

  STM (Maybe ProcData) -> IO (Maybe ProcData)
forall a. STM a -> IO a
STM.atomically (TMVar (Maybe ProcData) -> STM (Maybe ProcData)
forall a. TMVar a -> STM a
STM.takeTMVar TMVar (Maybe ProcData)
procVar) IO (Maybe ProcData) -> (Maybe ProcData -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just ProcData
p -> do
      STM () -> IOTask ()
forall a. STM a -> IO a
STM.atomically (STM () -> IOTask ()) -> STM () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ TMVar (Maybe ProcData) -> Maybe ProcData -> STM ()
forall a. TMVar a -> a -> STM ()
STM.putTMVar TMVar (Maybe ProcData)
procVar (Maybe ProcData -> STM ()) -> Maybe ProcData -> STM ()
forall a b. (a -> b) -> a -> b
$ ProcData -> Maybe ProcData
forall a. a -> Maybe a
Just ProcData
p
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[ERROR] PMS.Infra.ProcSpawn.DS.Core.genProcCMDTask: process is already running."
      [Char] -> IOTask ()
forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
[Char] -> m a
E.throwString [Char]
"[ERROR] PMS.Infra.ProcSpawn.DS.Core.genProcCMDTask: process is already running."
    Maybe ProcData
Nothing -> TMVar (Maybe ProcData)
-> [Char] -> [[Char]] -> [([Char], [Char])] -> IOTask ()
runProc TMVar (Maybe ProcData)
procVar [Char]
"cmd" [] []

  STM (Maybe ProcData) -> IO (Maybe ProcData)
forall a. STM a -> IO a
STM.atomically (TMVar (Maybe ProcData) -> STM (Maybe ProcData)
forall a. TMVar a -> STM a
STM.readTMVar TMVar (Maybe ProcData)
procVar) IO (Maybe ProcData) -> (Maybe ProcData -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe ProcData
Nothing -> do
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[ERROR] PMS.Infra.ProcSpawn.DS.Core.genProcCMDTask: process is not started."
      [Char] -> IOTask ()
forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
[Char] -> m a
E.throwString [Char]
"[ERROR] PMS.Infra.ProcSpawn.DS.Core.genProcCMDTask: process is not started."
    Just ProcData
procDat -> do
      let wHdl :: Handle
wHdl = ProcData
procDatProcData -> Getting Handle ProcData Handle -> Handle
forall s a. s -> Getting a s a -> a
^.Getting Handle ProcData Handle
Lens' ProcData Handle
wHdLProcData
          msg :: [Char]
msg  =  [Char]
"chcp 65001 & prompt $P$G$G$G"
          cmd :: ByteString
cmd  = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
DM._LF
      
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.ProcSpawn.DS.Core.genProcCMDTask writeProc : " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BS8.unpack ByteString
cmd
      Handle -> ByteString -> IOTask ()
BS.hPut Handle
wHdl ByteString
cmd
      Handle -> IOTask ()
hFlush Handle
wHdl

  STM (Maybe ProcData) -> IO (Maybe ProcData)
forall a. STM a -> IO a
STM.atomically (TMVar (Maybe ProcData) -> STM (Maybe ProcData)
forall a. TMVar a -> STM a
STM.readTMVar TMVar (Maybe ProcData)
procVar) IO (Maybe ProcData) -> (Maybe ProcData -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just ProcData
p -> IO (Maybe [Char]) -> IOTask () -> IO (Either (Maybe [Char]) ())
forall a b. IO a -> IO b -> IO (Either a b)
race (TMVar () -> IO ByteString -> [[Char]] -> IO (Maybe [Char])
DM.expect TMVar ()
lockTMVar (ProcData -> IO ByteString
readProc ProcData
p) [[Char]]
prompts) (Int -> IOTask ()
CC.threadDelay Int
tout) IO (Either (Maybe [Char]) ())
-> (Either (Maybe [Char]) () -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Maybe [Char]
res -> TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (ProcRunCommandData
cmdDatProcRunCommandData
-> Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
Lens' ProcRunCommandData JsonRpcRequest
DM.jsonrpcProcRunCommandData) ExitCode
ExitSuccess ([Char] -> ([Char] -> [Char]) -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"Nothing" [Char] -> [Char]
forall a. a -> a
id Maybe [Char]
res) [Char]
""
      Right ()
_  -> TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (ProcRunCommandData
cmdDatProcRunCommandData
-> Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
Lens' ProcRunCommandData JsonRpcRequest
DM.jsonrpcProcRunCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"timeout occurred."
    Maybe ProcData
Nothing -> do
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[ERROR] PMS.Infrastructure.DS.Core.genProcCMDTask: unexpected. proc not found."
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (ProcRunCommandData
cmdDatProcRunCommandData
-> Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
Lens' ProcRunCommandData JsonRpcRequest
DM.jsonrpcProcRunCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"unexpected. proc not found."

  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[INFO] PMS.Infra.ProcSpawn.DS.Core.genProcCMDTask end."

  where
    errHdl :: E.SomeException -> IO ()
    errHdl :: SomeException -> IOTask ()
errHdl SomeException
e = do
      STM () -> IOTask ()
forall a. STM a -> IO a
STM.atomically (STM () -> IOTask ()) -> STM () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ TMVar (Maybe ProcData) -> Maybe ProcData -> STM ()
forall a. TMVar a -> a -> STM ()
STM.putTMVar TMVar (Maybe ProcData)
procVar Maybe ProcData
forall a. Maybe a
Nothing
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[ERROR] PMS.Infra.ProcSpawn.DS.Core.genProcCMDTask: exception occurred. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (ProcRunCommandData
cmdDatProcRunCommandData
-> Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
Lens' ProcRunCommandData JsonRpcRequest
DM.jsonrpcProcRunCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)


-- |
--   
genProcPS :: DM.ProcRunCommandData -> AppContext (IOTask ())
genProcPS :: ProcRunCommandData -> AppContext (IOTask ())
genProcPS ProcRunCommandData
cmdDat = do
  $Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"genProcPS: called. "

  let tout :: Int
tout = Int
DM._TIMEOUT_MICROSEC

  [[Char]]
prompts <- Getting [[Char]] DomainData [[Char]] -> DomainData -> [[Char]]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [[Char]] DomainData [[Char]]
Lens' DomainData [[Char]]
DM.promptsDomainData (DomainData -> [[Char]])
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TQueue McpResponse
resQ <- Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
-> DomainData -> TQueue McpResponse
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
Lens' DomainData (TQueue McpResponse)
DM.responseQueueDomainData (DomainData -> TQueue McpResponse)
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TQueue McpResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TMVar (Maybe ProcData)
procMVar <- Getting (TMVar (Maybe ProcData)) AppData (TMVar (Maybe ProcData))
-> AppData -> TMVar (Maybe ProcData)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar (Maybe ProcData)) AppData (TMVar (Maybe ProcData))
Lens' AppData (TMVar (Maybe ProcData))
processAppData (AppData -> TMVar (Maybe ProcData))
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TMVar (Maybe ProcData))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TMVar ()
lockTMVar <- Getting (TMVar ()) AppData (TMVar ()) -> AppData -> TMVar ()
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar ()) AppData (TMVar ())
Lens' AppData (TMVar ())
lockAppData (AppData -> TMVar ())
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TMVar ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask
  
  IOTask () -> AppContext (IOTask ())
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOTask () -> AppContext (IOTask ()))
-> IOTask () -> AppContext (IOTask ())
forall a b. (a -> b) -> a -> b
$ ProcRunCommandData
-> TQueue McpResponse
-> TMVar (Maybe ProcData)
-> TMVar ()
-> [[Char]]
-> Int
-> IOTask ()
genProcPSTask ProcRunCommandData
cmdDat TQueue McpResponse
resQ TMVar (Maybe ProcData)
procMVar TMVar ()
lockTMVar [[Char]]
prompts Int
tout

-- |
--   
genProcPSTask :: DM.ProcRunCommandData
               -> STM.TQueue DM.McpResponse
               -> STM.TMVar (Maybe ProcData)
               -> STM.TMVar ()
               -> [String]
               -> Int
               -> IOTask ()
genProcPSTask :: ProcRunCommandData
-> TQueue McpResponse
-> TMVar (Maybe ProcData)
-> TMVar ()
-> [[Char]]
-> Int
-> IOTask ()
genProcPSTask ProcRunCommandData
cmdDat TQueue McpResponse
resQ TMVar (Maybe ProcData)
procVar TMVar ()
lockTMVar [[Char]]
prompts Int
tout = (IOTask () -> (SomeException -> IOTask ()) -> IOTask ())
-> (SomeException -> IOTask ()) -> IOTask () -> IOTask ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOTask () -> (SomeException -> IOTask ()) -> IOTask ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny SomeException -> IOTask ()
errHdl (IOTask () -> IOTask ()) -> IOTask () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ do
  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.ProcSpawn.DS.Core.genProcPSTask start. "
  let initCmd :: [Char]
initCmd = [Char]
"chcp 65001; $OutputEncoding = [Console]::OutputEncoding = New-Object System.Text.UTF8Encoding $false; function prompt { \"PS $((Get-Location).Path)>>>\" }"

  STM (Maybe ProcData) -> IO (Maybe ProcData)
forall a. STM a -> IO a
STM.atomically (TMVar (Maybe ProcData) -> STM (Maybe ProcData)
forall a. TMVar a -> STM a
STM.takeTMVar TMVar (Maybe ProcData)
procVar) IO (Maybe ProcData) -> (Maybe ProcData -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just ProcData
p -> do
      STM () -> IOTask ()
forall a. STM a -> IO a
STM.atomically (STM () -> IOTask ()) -> STM () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ TMVar (Maybe ProcData) -> Maybe ProcData -> STM ()
forall a. TMVar a -> a -> STM ()
STM.putTMVar TMVar (Maybe ProcData)
procVar (Maybe ProcData -> STM ()) -> Maybe ProcData -> STM ()
forall a b. (a -> b) -> a -> b
$ ProcData -> Maybe ProcData
forall a. a -> Maybe a
Just ProcData
p
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[ERROR] PMS.Infra.ProcSpawn.DS.Core.genProcPSTask: process is already running."
      [Char] -> IOTask ()
forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
[Char] -> m a
E.throwString [Char]
"[ERROR] PMS.Infra.ProcSpawn.DS.Core.genProcPSTask: process is already running."
    Maybe ProcData
Nothing -> TMVar (Maybe ProcData)
-> [Char] -> [[Char]] -> [([Char], [Char])] -> IOTask ()
runProc TMVar (Maybe ProcData)
procVar [Char]
"powershell" [[Char]
"-NoLogo", [Char]
"-NoExit", [Char]
"-Command", [Char]
initCmd] []

  STM (Maybe ProcData) -> IO (Maybe ProcData)
forall a. STM a -> IO a
STM.atomically (TMVar (Maybe ProcData) -> STM (Maybe ProcData)
forall a. TMVar a -> STM a
STM.readTMVar TMVar (Maybe ProcData)
procVar) IO (Maybe ProcData) -> (Maybe ProcData -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just ProcData
p -> IO (Maybe [Char]) -> IOTask () -> IO (Either (Maybe [Char]) ())
forall a b. IO a -> IO b -> IO (Either a b)
race (TMVar () -> IO ByteString -> [[Char]] -> IO (Maybe [Char])
DM.expect TMVar ()
lockTMVar (ProcData -> IO ByteString
readProc ProcData
p) [[Char]]
prompts) (Int -> IOTask ()
CC.threadDelay Int
tout) IO (Either (Maybe [Char]) ())
-> (Either (Maybe [Char]) () -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Maybe [Char]
res -> TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (ProcRunCommandData
cmdDatProcRunCommandData
-> Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
Lens' ProcRunCommandData JsonRpcRequest
DM.jsonrpcProcRunCommandData) ExitCode
ExitSuccess ([Char] -> ([Char] -> [Char]) -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"Nothing" [Char] -> [Char]
forall a. a -> a
id Maybe [Char]
res) [Char]
""
      Right ()
_  -> TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (ProcRunCommandData
cmdDatProcRunCommandData
-> Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
Lens' ProcRunCommandData JsonRpcRequest
DM.jsonrpcProcRunCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"timeout occurred."
    Maybe ProcData
Nothing -> do
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[ERROR] PMS.Infrastructure.DS.Core.genProcPSTask: unexpected. proc not found."
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (ProcRunCommandData
cmdDatProcRunCommandData
-> Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
Lens' ProcRunCommandData JsonRpcRequest
DM.jsonrpcProcRunCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"unexpected. proc not found."

  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[INFO] PMS.Infra.ProcSpawn.DS.Core.genProcPSTask end."

  where
    errHdl :: E.SomeException -> IO ()
    errHdl :: SomeException -> IOTask ()
errHdl SomeException
e = do
      STM () -> IOTask ()
forall a. STM a -> IO a
STM.atomically (STM () -> IOTask ()) -> STM () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ TMVar (Maybe ProcData) -> Maybe ProcData -> STM ()
forall a. TMVar a -> a -> STM ()
STM.putTMVar TMVar (Maybe ProcData)
procVar Maybe ProcData
forall a. Maybe a
Nothing
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[ERROR] PMS.Infra.ProcSpawn.DS.Core.genProcPSTask: exception occurred. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (ProcRunCommandData
cmdDatProcRunCommandData
-> Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest ProcRunCommandData JsonRpcRequest
Lens' ProcRunCommandData JsonRpcRequest
DM.jsonrpcProcRunCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)

-- |
--
genProcTerminateTask :: DM.ProcTerminateCommandData -> AppContext (IOTask ())
genProcTerminateTask :: ProcTerminateCommandData -> AppContext (IOTask ())
genProcTerminateTask ProcTerminateCommandData
dat = do
  $Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"genProcTerminateTask called. "
  TMVar (Maybe ProcData)
procTMVar <- Getting (TMVar (Maybe ProcData)) AppData (TMVar (Maybe ProcData))
-> AppData -> TMVar (Maybe ProcData)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar (Maybe ProcData)) AppData (TMVar (Maybe ProcData))
Lens' AppData (TMVar (Maybe ProcData))
processAppData (AppData -> TMVar (Maybe ProcData))
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TMVar (Maybe ProcData))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TQueue McpResponse
resQ <- Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
-> DomainData -> TQueue McpResponse
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
Lens' DomainData (TQueue McpResponse)
DM.responseQueueDomainData (DomainData -> TQueue McpResponse)
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TQueue McpResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
  IOTask () -> AppContext (IOTask ())
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOTask () -> AppContext (IOTask ()))
-> IOTask () -> AppContext (IOTask ())
forall a b. (a -> b) -> a -> b
$ ProcTerminateCommandData
-> TQueue McpResponse -> TMVar (Maybe ProcData) -> IOTask ()
procTerminateTask ProcTerminateCommandData
dat TQueue McpResponse
resQ TMVar (Maybe ProcData)
procTMVar

-- |
--
procTerminateTask :: DM.ProcTerminateCommandData
                  -> STM.TQueue DM.McpResponse
                  -> STM.TMVar (Maybe ProcData)
                  -> IOTask ()
procTerminateTask :: ProcTerminateCommandData
-> TQueue McpResponse -> TMVar (Maybe ProcData) -> IOTask ()
procTerminateTask ProcTerminateCommandData
cmdDat TQueue McpResponse
resQ TMVar (Maybe ProcData)
procTMVar = (IOTask () -> (SomeException -> IOTask ()) -> IOTask ())
-> (SomeException -> IOTask ()) -> IOTask () -> IOTask ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOTask () -> (SomeException -> IOTask ()) -> IOTask ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny SomeException -> IOTask ()
errHdl (IOTask () -> IOTask ()) -> IOTask () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ do
  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.ProcSpawn.DS.Core.procTerminateTask run. "
  let jsonRpc :: JsonRpcRequest
jsonRpc = ProcTerminateCommandData
cmdDatProcTerminateCommandData
-> Getting JsonRpcRequest ProcTerminateCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest ProcTerminateCommandData JsonRpcRequest
Iso' ProcTerminateCommandData JsonRpcRequest
DM.jsonrpcProcTerminateCommandData

  STM (Maybe ProcData) -> IO (Maybe ProcData)
forall a. STM a -> IO a
STM.atomically (TMVar (Maybe ProcData) -> Maybe ProcData -> STM (Maybe ProcData)
forall a. TMVar a -> a -> STM a
STM.swapTMVar TMVar (Maybe ProcData)
procTMVar Maybe ProcData
forall a. Maybe a
Nothing) IO (Maybe ProcData) -> (Maybe ProcData -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe ProcData
Nothing -> do
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[ERROR] PMS.Infra.ProcSpawn.DS.Core.procTerminateTask: process is not started."
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ JsonRpcRequest
jsonRpc (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"process is not started."
    Just ProcData
procDat -> do
      let pHdl :: ProcessHandle
pHdl = ProcData
procDatProcData
-> Getting ProcessHandle ProcData ProcessHandle -> ProcessHandle
forall s a. s -> Getting a s a -> a
^.Getting ProcessHandle ProcData ProcessHandle
Lens' ProcData ProcessHandle
pHdlProcData
      ProcessHandle -> IOTask ()
S.terminateProcess ProcessHandle
pHdl
      ExitCode
exitCode <- ProcessHandle -> IO ExitCode
S.waitForProcess ProcessHandle
pHdl
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ JsonRpcRequest
jsonRpc ExitCode
exitCode [Char]
"" [Char]
"process is teminated."
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.ProcSpawn.DS.Core.procTerminateTask closeProc : " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ExitCode -> [Char]
forall a. Show a => a -> [Char]
show ExitCode
exitCode

  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[INFO] PMS.Infra.ProcSpawn.DS.Core.procTerminateTask end."

  where
    -- |
    --
    errHdl :: E.SomeException -> IO ()
    errHdl :: SomeException -> IOTask ()
errHdl SomeException
e = TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (ProcTerminateCommandData
cmdDatProcTerminateCommandData
-> Getting JsonRpcRequest ProcTerminateCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest ProcTerminateCommandData JsonRpcRequest
Iso' ProcTerminateCommandData JsonRpcRequest
DM.jsonrpcProcTerminateCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)


-- |
--
genProcMessageTask :: DM.ProcMessageCommandData -> AppContext (IOTask ())
genProcMessageTask :: ProcMessageCommandData -> AppContext (IOTask ())
genProcMessageTask ProcMessageCommandData
cmdData = do
  let argsBS :: ByteString
argsBS = RawJsonByteString -> ByteString
DM.unRawJsonByteString (RawJsonByteString -> ByteString)
-> RawJsonByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ProcMessageCommandData
cmdDataProcMessageCommandData
-> Getting
     RawJsonByteString ProcMessageCommandData RawJsonByteString
-> RawJsonByteString
forall s a. s -> Getting a s a -> a
^.Getting RawJsonByteString ProcMessageCommandData RawJsonByteString
Lens' ProcMessageCommandData RawJsonByteString
DM.argumentsProcMessageCommandData
      tout :: Int
tout = Int
30 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000
  [[Char]]
prompts <- Getting [[Char]] DomainData [[Char]] -> DomainData -> [[Char]]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [[Char]] DomainData [[Char]]
Lens' DomainData [[Char]]
DM.promptsDomainData (DomainData -> [[Char]])
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TQueue McpResponse
resQ <- Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
-> DomainData -> TQueue McpResponse
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
Lens' DomainData (TQueue McpResponse)
DM.responseQueueDomainData (DomainData -> TQueue McpResponse)
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TQueue McpResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TMVar (Maybe ProcData)
procTMVar <- Getting (TMVar (Maybe ProcData)) AppData (TMVar (Maybe ProcData))
-> AppData -> TMVar (Maybe ProcData)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar (Maybe ProcData)) AppData (TMVar (Maybe ProcData))
Lens' AppData (TMVar (Maybe ProcData))
processAppData (AppData -> TMVar (Maybe ProcData))
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TMVar (Maybe ProcData))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TMVar ()
lockTMVar <- Getting (TMVar ()) AppData (TMVar ()) -> AppData -> TMVar ()
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar ()) AppData (TMVar ())
Lens' AppData (TMVar ())
lockAppData (AppData -> TMVar ())
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TMVar ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask
  ProcStringToolParams
argsDat <- Either [Char] ProcStringToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     ProcStringToolParams
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [Char] ProcStringToolParams
 -> ReaderT
      AppData
      (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
      ProcStringToolParams)
-> Either [Char] ProcStringToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     ProcStringToolParams
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] ProcStringToolParams
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode (ByteString -> Either [Char] ProcStringToolParams)
-> ByteString -> Either [Char] ProcStringToolParams
forall a b. (a -> b) -> a -> b
$ ByteString
argsBS
  let args :: [Char]
args = ProcStringToolParams
argsDatProcStringToolParams
-> Getting [Char] ProcStringToolParams [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] ProcStringToolParams [Char]
Iso' ProcStringToolParams [Char]
argumentsProcStringToolParams

  $Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"genProcMessageTask: args. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
args
  IOTask () -> AppContext (IOTask ())
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOTask () -> AppContext (IOTask ()))
-> IOTask () -> AppContext (IOTask ())
forall a b. (a -> b) -> a -> b
$ ProcMessageCommandData
-> TQueue McpResponse
-> TMVar (Maybe ProcData)
-> TMVar ()
-> [Char]
-> [[Char]]
-> Int
-> IOTask ()
procMessageTask ProcMessageCommandData
cmdData TQueue McpResponse
resQ TMVar (Maybe ProcData)
procTMVar TMVar ()
lockTMVar [Char]
args [[Char]]
prompts Int
tout

-- |
--
procMessageTask :: DM.ProcMessageCommandData
                -> STM.TQueue DM.McpResponse
                -> STM.TMVar (Maybe ProcData)
                -> STM.TMVar ()
                -> String  -- arguments line
                -> [String]  -- prompt list
                -> Int       -- timeout microsec
                -> IOTask ()
procMessageTask :: ProcMessageCommandData
-> TQueue McpResponse
-> TMVar (Maybe ProcData)
-> TMVar ()
-> [Char]
-> [[Char]]
-> Int
-> IOTask ()
procMessageTask ProcMessageCommandData
cmdDat TQueue McpResponse
resQ TMVar (Maybe ProcData)
procTMVar TMVar ()
lockTMVar [Char]
args [[Char]]
prompts Int
tout = (IOTask () -> (SomeException -> IOTask ()) -> IOTask ())
-> (SomeException -> IOTask ()) -> IOTask () -> IOTask ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOTask () -> (SomeException -> IOTask ()) -> IOTask ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny SomeException -> IOTask ()
errHdl (IOTask () -> IOTask ()) -> IOTask () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ do
  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.ProcSpawn.DS.Core.procMessageTask run. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
args
    
  STM (Maybe ProcData) -> IO (Maybe ProcData)
forall a. STM a -> IO a
STM.atomically (TMVar (Maybe ProcData) -> STM (Maybe ProcData)
forall a. TMVar a -> STM a
STM.readTMVar TMVar (Maybe ProcData)
procTMVar) IO (Maybe ProcData) -> (Maybe ProcData -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe ProcData
Nothing -> do
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[ERROR] PMS.Infra.ProcSpawn.DS.Core.procMessageTask: process is not started."
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ JsonRpcRequest
jsonRpc (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"process is not started."
    Just ProcData
p -> ProcData -> IOTask ()
go ProcData
p

  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[INFO] PMS.Infra.ProcSpawn.DS.Core.procMessageTask end."

  where
    jsonRpc :: DM.JsonRpcRequest
    jsonRpc :: JsonRpcRequest
jsonRpc = ProcMessageCommandData
cmdDatProcMessageCommandData
-> Getting JsonRpcRequest ProcMessageCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest ProcMessageCommandData JsonRpcRequest
Lens' ProcMessageCommandData JsonRpcRequest
DM.jsonrpcProcMessageCommandData

    errHdl :: E.SomeException -> IO ()
    errHdl :: SomeException -> IOTask ()
errHdl SomeException
e = TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ JsonRpcRequest
jsonRpc (Int -> ExitCode
ExitFailure Int
1) [Char]
"" (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)

    go :: ProcData -> IO ()
    go :: ProcData -> IOTask ()
go ProcData
pDat = do
      let wHdl :: Handle
wHdl = ProcData
pDatProcData -> Getting Handle ProcData Handle -> Handle
forall s a. s -> Getting a s a -> a
^.Getting Handle ProcData Handle
Lens' ProcData Handle
wHdLProcData

      [Char]
msg <- [Char] -> IO [Char]
DM.validateMessage [Char]
args
      let cmd :: ByteString
cmd = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
DM._LF

      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.ProcSpawn.DS.Core.procMessageTask writeProc : " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BS8.unpack ByteString
cmd

      Handle -> ByteString -> IOTask ()
BS.hPut Handle
wHdl ByteString
cmd
      Handle -> IOTask ()
hFlush Handle
wHdl

      IO (Maybe [Char]) -> IOTask () -> IO (Either (Maybe [Char]) ())
forall a b. IO a -> IO b -> IO (Either a b)
race (TMVar () -> IO ByteString -> [[Char]] -> IO (Maybe [Char])
DM.expect TMVar ()
lockTMVar (ProcData -> IO ByteString
readProc ProcData
pDat) [[Char]]
prompts) (Int -> IOTask ()
CC.threadDelay Int
tout) IO (Either (Maybe [Char]) ())
-> (Either (Maybe [Char]) () -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left Maybe [Char]
res -> TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ JsonRpcRequest
jsonRpc ExitCode
ExitSuccess ([Char] -> ([Char] -> [Char]) -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"Nothing" [Char] -> [Char]
forall a. a -> a
id Maybe [Char]
res) [Char]
""
        Right ()
_  -> TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ JsonRpcRequest
jsonRpc (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"timeout occurred."