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

module PMS.Infra.CmdRun.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.STM as STM
import Data.Conduit
import qualified Control.Concurrent as CC
import Control.Concurrent.Async
import qualified Data.Text as T
import Control.Monad.Except
import System.Process
import System.FilePath
import Data.Aeson
import qualified Control.Exception.Safe as E
import System.Exit

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

import PMS.Infra.CmdRun.DM.Type
import PMS.Infra.CmdRun.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
  ()
  CmdRunCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
src ConduitT
  ()
  CmdRunCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
-> ConduitT
     CmdRunCommand
     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
  CmdRunCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
cmd2task ConduitT
  CmdRunCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     CmdRunCommand
     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.CmdRunCommand AppContext ()
src :: ConduitT
  ()
  CmdRunCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
src = AppContext CmdRunCommand
-> ConduitT
     ()
     CmdRunCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     CmdRunCommand
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT () CmdRunCommand m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift AppContext CmdRunCommand
go ConduitT
  ()
  CmdRunCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  CmdRunCommand
-> (CmdRunCommand
    -> ConduitT
         ()
         CmdRunCommand
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         ())
-> ConduitT
     ()
     CmdRunCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b.
ConduitT
  ()
  CmdRunCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> (a
    -> ConduitT
         ()
         CmdRunCommand
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         b)
-> ConduitT
     ()
     CmdRunCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CmdRunCommand
-> ConduitT
     ()
     CmdRunCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ConduitT
  ()
  CmdRunCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
-> ConduitT
     ()
     CmdRunCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     ()
     CmdRunCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b.
ConduitT
  ()
  CmdRunCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> ConduitT
     ()
     CmdRunCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
-> ConduitT
     ()
     CmdRunCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT
  ()
  CmdRunCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
src
  where
    go :: AppContext DM.CmdRunCommand
    go :: AppContext CmdRunCommand
go = do
      TQueue CmdRunCommand
queue <- Getting (TQueue CmdRunCommand) DomainData (TQueue CmdRunCommand)
-> DomainData -> TQueue CmdRunCommand
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TQueue CmdRunCommand) DomainData (TQueue CmdRunCommand)
Lens' DomainData (TQueue CmdRunCommand)
DM.cmdRunQueueDomainData (DomainData -> TQueue CmdRunCommand)
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TQueue CmdRunCommand)
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
      IO CmdRunCommand -> AppContext CmdRunCommand
forall a.
IO a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CmdRunCommand -> AppContext CmdRunCommand)
-> IO CmdRunCommand -> AppContext CmdRunCommand
forall a b. (a -> b) -> a -> b
$ STM CmdRunCommand -> IO CmdRunCommand
forall a. STM a -> IO a
STM.atomically (STM CmdRunCommand -> IO CmdRunCommand)
-> STM CmdRunCommand -> IO CmdRunCommand
forall a b. (a -> b) -> a -> b
$ TQueue CmdRunCommand -> STM CmdRunCommand
forall a. TQueue a -> STM a
STM.readTQueue TQueue CmdRunCommand
queue

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

  where
    errHdl :: DM.CmdRunCommand -> String -> ConduitT DM.CmdRunCommand (IOTask ()) AppContext ()
    errHdl :: CmdRunCommand
-> [Char]
-> ConduitT
     CmdRunCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
errHdl CmdRunCommand
cmdCmd [Char]
msg = do
      let jsonrpc :: JsonRpcRequest
jsonrpc = CmdRunCommand -> JsonRpcRequest
DM.getJsonRpcCmdRunCommand CmdRunCommand
cmdCmd
      $Text
-> Text
-> ConduitT
     CmdRunCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
logWarnS Text
DM._LOGTAG (Text
 -> ConduitT
      CmdRunCommand
      (IOTask ())
      (ReaderT
         AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
      ())
-> Text
-> ConduitT
     CmdRunCommand
     (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
     CmdRunCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT CmdRunCommand (IOTask ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (AppContext ()
 -> ConduitT
      CmdRunCommand
      (IOTask ())
      (ReaderT
         AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
      ())
-> AppContext ()
-> ConduitT
     CmdRunCommand
     (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
  CmdRunCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
cmd2task

    go :: DM.CmdRunCommand -> AppContext (IOTask ())
    go :: CmdRunCommand -> AppContext (IOTask ())
go (DM.EchoCmdRunCommand EchoCmdRunCommandData
dat) = EchoCmdRunCommandData -> AppContext (IOTask ())
genEchoTask EchoCmdRunCommandData
dat
    go (DM.DefaultCmdRunCommand DefaultCmdRunCommandData
dat) = DefaultCmdRunCommandData -> AppContext (IOTask ())
genCmdRunTask DefaultCmdRunCommandData
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 ()
t = 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 ()
t
      $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.EchoCmdRunCommandData -> AppContext (IOTask ())
genEchoTask :: EchoCmdRunCommandData -> AppContext (IOTask ())
genEchoTask EchoCmdRunCommandData
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 = EchoCmdRunCommandData
datEchoCmdRunCommandData
-> Getting [Char] EchoCmdRunCommandData [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] EchoCmdRunCommandData [Char]
Lens' EchoCmdRunCommandData [Char]
DM.valueEchoCmdRunCommandData

  $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 -> EchoCmdRunCommandData -> [Char] -> IOTask ()
echoTask TQueue McpResponse
resQ EchoCmdRunCommandData
dat [Char]
val


-- |
--   
echoTask :: STM.TQueue DM.McpResponse -> DM.EchoCmdRunCommandData -> String -> IOTask ()
echoTask :: TQueue McpResponse -> EchoCmdRunCommandData -> [Char] -> IOTask ()
echoTask TQueue McpResponse
resQ EchoCmdRunCommandData
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.CmdRun.DS.Core.work.echoTask run. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
val

  ExitCode -> [Char] -> [Char] -> IOTask ()
response ExitCode
ExitSuccess [Char]
val [Char]
""

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

  where
    errHdl :: E.SomeException -> IO ()
    errHdl :: SomeException -> IOTask ()
errHdl SomeException
e = ExitCode -> [Char] -> [Char] -> IOTask ()
response (Int -> ExitCode
ExitFailure Int
1) [Char]
"" (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)

    response :: ExitCode -> String -> String -> IO ()
    response :: ExitCode -> [Char] -> [Char] -> IOTask ()
response ExitCode
code [Char]
outStr [Char]
errStr = do
      let jsonRpc :: JsonRpcRequest
jsonRpc = EchoCmdRunCommandData
cmdDatEchoCmdRunCommandData
-> Getting JsonRpcRequest EchoCmdRunCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest EchoCmdRunCommandData JsonRpcRequest
Lens' EchoCmdRunCommandData JsonRpcRequest
DM.jsonrpcEchoCmdRunCommandData
          content :: [McpToolsCallResponseResultContent]
content = [ [Char] -> [Char] -> McpToolsCallResponseResultContent
DM.McpToolsCallResponseResultContent [Char]
"text" [Char]
outStr
                    , [Char] -> [Char] -> McpToolsCallResponseResultContent
DM.McpToolsCallResponseResultContent [Char]
"text" [Char]
errStr
                    ]
          result :: McpToolsCallResponseResult
result = DM.McpToolsCallResponseResult {
                      _contentMcpToolsCallResponseResult :: [McpToolsCallResponseResultContent]
DM._contentMcpToolsCallResponseResult = [McpToolsCallResponseResultContent]
content
                    , _isErrorMcpToolsCallResponseResult :: Bool
DM._isErrorMcpToolsCallResponseResult = (ExitCode
ExitSuccess ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
code)
                    }
          resDat :: McpToolsCallResponseData
resDat = JsonRpcRequest
-> McpToolsCallResponseResult -> McpToolsCallResponseData
DM.McpToolsCallResponseData JsonRpcRequest
jsonRpc McpToolsCallResponseResult
result
          res :: McpResponse
res = McpToolsCallResponseData -> McpResponse
DM.McpToolsCallResponse McpToolsCallResponseData
resDat

      STM () -> IOTask ()
forall a. STM a -> IO a
STM.atomically (STM () -> IOTask ()) -> STM () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ TQueue McpResponse -> McpResponse -> STM ()
forall a. TQueue a -> a -> STM ()
STM.writeTQueue TQueue McpResponse
resQ McpResponse
res

-- |
--
genCmdRunTask :: DM.DefaultCmdRunCommandData -> AppContext (IOTask ())
genCmdRunTask :: DefaultCmdRunCommandData -> AppContext (IOTask ())
genCmdRunTask DefaultCmdRunCommandData
dat = do
  [Char]
toolsDir <- 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.toolsDirDomainData (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
  let nameTmp :: [Char]
nameTmp = DefaultCmdRunCommandData
datDefaultCmdRunCommandData
-> Getting [Char] DefaultCmdRunCommandData [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] DefaultCmdRunCommandData [Char]
Lens' DefaultCmdRunCommandData [Char]
DM.nameDefaultCmdRunCommandData
      argsBS :: ByteString
argsBS = RawJsonByteString -> ByteString
DM.unRawJsonByteString (RawJsonByteString -> ByteString)
-> RawJsonByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ DefaultCmdRunCommandData
datDefaultCmdRunCommandData
-> Getting
     RawJsonByteString DefaultCmdRunCommandData RawJsonByteString
-> RawJsonByteString
forall s a. s -> Getting a s a -> a
^.Getting
  RawJsonByteString DefaultCmdRunCommandData RawJsonByteString
Lens' DefaultCmdRunCommandData RawJsonByteString
DM.argumentsDefaultCmdRunCommandData
  StringToolParams
args <- Either [Char] StringToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     StringToolParams
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [Char] StringToolParams
 -> ReaderT
      AppData
      (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
      StringToolParams)
-> Either [Char] StringToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     StringToolParams
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] StringToolParams
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode (ByteString -> Either [Char] StringToolParams)
-> ByteString -> Either [Char] StringToolParams
forall a b. (a -> b) -> a -> b
$ ByteString
argsBS
  
  [Char]
name <- 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.validateCommand [Char]
nameTmp
  [Char]
argsStr <- 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.validateArg ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ StringToolParams
argsStringToolParams
-> Getting [Char] StringToolParams [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] StringToolParams [Char]
Iso' StringToolParams [Char]
argumentsStringToolParams
#ifdef mingw32_HOST_OS
  let scriptExt = ".bat"
#else
  let scriptExt :: [Char]
scriptExt = [Char]
".sh"
#endif

  let cmd :: [Char]
cmd = [Char]
toolsDir [Char] -> [Char] -> [Char]
</> [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
scriptExt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
argsStr

  $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]
"cmdRunTask: system cmd. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cmd
  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
-> DefaultCmdRunCommandData -> [Char] -> IOTask ()
cmdRunTask TQueue McpResponse
resQ DefaultCmdRunCommandData
dat [Char]
cmd


-- |
--   
cmdRunTask :: STM.TQueue DM.McpResponse -> DM.DefaultCmdRunCommandData -> String -> IOTask ()
cmdRunTask :: TQueue McpResponse
-> DefaultCmdRunCommandData -> [Char] -> IOTask ()
cmdRunTask TQueue McpResponse
resQ DefaultCmdRunCommandData
cmdDat [Char]
cmd = (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.CmdRun.DS.Core.work.cmdRunTask run. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cmd
  let 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

  IO (ExitCode, [Char], [Char])
-> IOTask () -> IO (Either (ExitCode, [Char], [Char]) ())
forall a b. IO a -> IO b -> IO (Either a b)
race (CreateProcess -> [Char] -> IO (ExitCode, [Char], [Char])
readCreateProcessWithExitCode ([Char] -> CreateProcess
shell [Char]
cmd) [Char]
"") (Int -> IOTask ()
CC.threadDelay Int
tout) IO (Either (ExitCode, [Char], [Char]) ())
-> (Either (ExitCode, [Char], [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 (ExitCode
code, [Char]
out, [Char]
err)  -> ExitCode -> [Char] -> [Char] -> IOTask ()
response ExitCode
code [Char]
out [Char]
err
    Right ()
_ -> [Char] -> IOTask ()
forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
[Char] -> m a
E.throwString [Char]
"timeout occurred."

  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[INFO] PMS.Infra.CmdRun.DS.Core.work.cmdRunTask end."

  where
    errHdl :: E.SomeException -> IO ()
    errHdl :: SomeException -> IOTask ()
errHdl SomeException
e = ExitCode -> [Char] -> [Char] -> IOTask ()
response (Int -> ExitCode
ExitFailure Int
1) [Char]
"" (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)

    response :: ExitCode -> String -> String -> IO ()
    response :: ExitCode -> [Char] -> [Char] -> IOTask ()
response ExitCode
code [Char]
outStr [Char]
errStr = do
      let jsonRpc :: JsonRpcRequest
jsonRpc = DefaultCmdRunCommandData
cmdDatDefaultCmdRunCommandData
-> Getting JsonRpcRequest DefaultCmdRunCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest DefaultCmdRunCommandData JsonRpcRequest
Lens' DefaultCmdRunCommandData JsonRpcRequest
DM.jsonrpcDefaultCmdRunCommandData
          content :: [McpToolsCallResponseResultContent]
content = [ [Char] -> [Char] -> McpToolsCallResponseResultContent
DM.McpToolsCallResponseResultContent [Char]
"text" [Char]
outStr
                    , [Char] -> [Char] -> McpToolsCallResponseResultContent
DM.McpToolsCallResponseResultContent [Char]
"text" [Char]
errStr
                    ]
          result :: McpToolsCallResponseResult
result = DM.McpToolsCallResponseResult {
                      _contentMcpToolsCallResponseResult :: [McpToolsCallResponseResultContent]
DM._contentMcpToolsCallResponseResult = [McpToolsCallResponseResultContent]
content
                    , _isErrorMcpToolsCallResponseResult :: Bool
DM._isErrorMcpToolsCallResponseResult = (ExitCode
ExitSuccess ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
code)
                    }
          resDat :: McpToolsCallResponseData
resDat = JsonRpcRequest
-> McpToolsCallResponseResult -> McpToolsCallResponseData
DM.McpToolsCallResponseData JsonRpcRequest
jsonRpc McpToolsCallResponseResult
result
          res :: McpResponse
res = McpToolsCallResponseData -> McpResponse
DM.McpToolsCallResponse McpToolsCallResponseData
resDat

      STM () -> IOTask ()
forall a. STM a -> IO a
STM.atomically (STM () -> IOTask ()) -> STM () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ TQueue McpResponse -> McpResponse -> STM ()
forall a. TQueue a -> a -> STM ()
STM.writeTQueue TQueue McpResponse
resQ McpResponse
res