pms-domain-service 0.0.1.0 → 0.0.2.0

raw patch · 14 files changed

+293/−169 lines, 14 files

Files

• CHANGELOG.md +4/−0
• pms-domain-service.cabal +7/−4
• src/PMS/Domain/Service/DM/Constant.hs +0/−5
• src/PMS/Domain/Service/DM/TH.hs +3/−3
• src/PMS/Domain/Service/DM/Type.hs +2/−2
• src/PMS/Domain/Service/DS/Core.hs +1/−1
• src/PMS/Domain/Service/DS/State/Run.hs +3/−110
• src/PMS/Domain/Service/DS/State/Run/ToolsCall.hs +137/−0
• src/PMS/Domain/Service/DS/State/Run/ToolsList.hs +46/−0
• src/PMS/Domain/Service/DS/State/Start.hs +14/−2
• src/PMS/Domain/Service/DS/State/Start/Init.hs +0/−41
• src/PMS/Domain/Service/DS/State/Start/Initialize.hs +41/−0
• src/PMS/Domain/Service/DS/State/Start/Initialized.hs +34/−0
• src/PMS/Domain/Service/DS/State/Stop.hs +1/−1

@@ -1,5 +1,9 @@ # Revision history for pms-domain-service +## 0.0.2.0 -- 2025-06-22++* Added file change monitoring for tools-list.json.+ ## 0.0.1.0 -- 2025-05-31  * First version.

@@ -20,7 +20,7 @@ -- PVP summary:     +-+------- breaking API changes --                  | | +----- non-breaking API additions --                  | | | +--- code changes with no API change-version:            0.0.1.0+version:            0.0.2.0  -- A short (one-line) description of the package. synopsis:           pms-domain-service@@ -56,7 +56,7 @@  library     -- Import common warning flags.-    ghc-options: -Wall -Wno-orphans -Wno-x-partial -Wno-gadt-mono-local-binds+    ghc-options: -Wall -threaded -Wno-orphans -Wno-x-partial -Wno-gadt-mono-local-binds      -- Modules exported by the library.     exposed-modules:  PMS.Domain.Service.DM.Type,@@ -66,9 +66,12 @@                       PMS.Domain.Service.DM.TH,                       PMS.Domain.Service.DS.Utility,                       PMS.Domain.Service.DS.State.Run,+                      PMS.Domain.Service.DS.State.Run.ToolsList,+                      PMS.Domain.Service.DS.State.Run.ToolsCall,                       PMS.Domain.Service.DS.State.Start,                       PMS.Domain.Service.DS.State.Start.Disconnect,-                      PMS.Domain.Service.DS.State.Start.Init,+                      PMS.Domain.Service.DS.State.Start.Initialize,+                      PMS.Domain.Service.DS.State.Start.Initialized,                       PMS.Domain.Service.DS.State.Start.Launch,                       PMS.Domain.Service.DS.State.Start.Terminate,                       PMS.Domain.Service.DS.State.Stop@@ -107,7 +110,7 @@  test-suite pms-domain-service-test     -- Import common warning flags.-    ghc-options: -Wall -Wno-orphans -Wno-x-partial+    ghc-options: -Wall -threaded -Wno-orphans -Wno-x-partial      -- Base language which the package is written in.     default-language: GHC2021

@@ -6,8 +6,3 @@ _LOG_FILE_NAME :: String _LOG_FILE_NAME = "pms-domain-service.log" --- |----_TOOLS_LIST_FILE :: String-_TOOLS_LIST_FILE = "tools-list.json"-

@@ -38,7 +38,7 @@  [InstanceD Nothing [] (AppT (ConT Type.IAppState) (ConT Type.StartState))   [FunD Type.doActivity-    [Clause [VarP s_8,ConP Type.EventW [AsP r_9 (RecP Type.InitEvent [])]] (NormalB (AppE (AppE (VarE Type.action) (VarE s_8)) (VarE r_9))) [],+    [Clause [VarP s_8,ConP Type.EventW [AsP r_9 (RecP Type.InitializeEvent [])]] (NormalB (AppE (AppE (VarE Type.action) (VarE s_8)) (VarE r_9))) [],      Clause [VarP s_10,ConP Type.EventW [AsP r_11 (RecP Type.TerminateEvent [])]] (NormalB (AppE (AppE (VarE Type.action) (VarE s_10)) (VarE r_11))) []     ]   ]@@ -55,11 +55,11 @@ :{  runQ [d|    data Event r where-     InitEvent :: Event InitEvent+     InitializeEvent :: Event InitializeEvent    |] :} -[DataD [] Event_12 [PlainTV r_14] Nothing [GadtC [InitEvent_13] [] (AppT (ConT Event_12) (ConT Type.InitEvent))] []]+[DataD [] Event_12 [PlainTV r_14] Nothing [GadtC [InitializeEvent_13] [] (AppT (ConT Event_12) (ConT Type.InitializeEvent))] []]  -} 

@@ -29,7 +29,7 @@ data ExitEventData        = ExitEventData  deriving (Show) data TransitEventData     = TransitEventData StateTransition deriving (Show) -- doActibity-data InitEventData        = InitEventData DM.McpInitializeRequestData deriving (Show)+data InitializeEventData        = InitializeEventData DM.McpInitializeRequestData deriving (Show) data InitializedEventData = InitializedEventData DM.McpInitializedNotificationData deriving (Show) data ToolsListEventData   = ToolsListEventData DM.McpToolsListRequestData deriving (Show) data ToolsCallEventData   = ToolsCallEventData DM.McpToolsCallRequestData deriving (Show)@@ -44,7 +44,7 @@   ExitEvent        :: Event ExitEventData   TransitEvent     :: TransitEventData     -> Event TransitEventData   -- doActibity-  InitEvent        :: InitEventData        -> Event InitEventData+  InitializeEvent  :: InitializeEventData  -> Event InitializeEventData   InitializedEvent :: InitializedEventData -> Event InitializedEventData   ToolsListEvent   :: ToolsListEventData   -> Event ToolsListEventData   ToolsCallEvent   :: ToolsCallEventData   -> Event ToolsCallEventData

@@ -76,7 +76,7 @@ -- | -- req2ev :: DM.McpRequest -> AppContext EventW-req2ev (DM.McpInitializeRequest dat) = pure . EventW . InitEvent . InitEventData $ dat+req2ev (DM.McpInitializeRequest dat) = pure . EventW . InitializeEvent . InitializeEventData $ dat req2ev (DM.McpInitializedNotification dat) = pure . EventW . InitializedEvent . InitializedEventData $ dat req2ev (DM.McpToolsListRequest dat) = pure . EventW . ToolsListEvent . ToolsListEventData $ dat req2ev (DM.McpToolsCallRequest dat) = pure . EventW . ToolsCallEvent . ToolsCallEventData $ dat

@@ -5,26 +5,15 @@  module PMS.Domain.Service.DS.State.Run where --import System.IO-import Control.Monad.IO.Class-import Control.Monad.Trans.Class import Control.Monad.Logger-import qualified Data.Text as T-import Control.Lens-import Control.Monad.Reader-import qualified Control.Concurrent.STM as STM-import System.FilePath-import System.Exit -import qualified PMS.Domain.Model.DM.Type as DM import qualified PMS.Domain.Model.DM.Constant as DM  import PMS.Domain.Service.DM.Type import PMS.Domain.Service.DM.TH-import PMS.Domain.Service.DM.Constant-import qualified PMS.Domain.Service.DS.Utility as U +import PMS.Domain.Service.DS.State.Run.ToolsList()+import PMS.Domain.Service.DS.State.Run.ToolsCall()   instanceTH_IAppState ''RunStateData@@ -50,7 +39,7 @@  -- | ---instance IStateActivity RunStateData InitEventData+instance IStateActivity RunStateData InitializeEventData   -- @see default implementation in Type module.  -- |@@ -76,99 +65,3 @@ -- instance IStateActivity RunStateData InitializedEventData   -- @see default implementation in Type module.---- |----instance IStateActivity RunStateData ToolsListEventData where-  action s (ToolsListEvent r@(ToolsListEventData dat)) = do-    $logDebugS DM._LOGTAG "Run ToolsListEvent called."-    $logDebugS DM._LOGTAG (T.pack (show s))-    $logDebugS DM._LOGTAG (T.pack (show r))--    scriptsDir <- view DM.scriptsDirDomainData <$> lift ask--    let toolFile = scriptsDir </> _TOOLS_LIST_FILE-    cont <- U.readFile toolFile-    let result = DM.McpToolsListResponseResult $ DM.RawJsonByteString cont-        jsonRpc = dat^.DM.jsonrpcMcpToolsListRequestData-        resDat = DM.McpToolsListResponseData jsonRpc result-        res = DM.McpToolsListResponse resDat--    $logDebugS DM._LOGTAG $ T.pack $ show res--    queue <- view DM.responseQueueDomainData <$> lift ask-    liftIO $ STM.atomically $ STM.writeTQueue queue res--    return noStateTransition---- |----instance IStateActivity RunStateData ToolsCallEventData where-  action _ (ToolsCallEvent (ToolsCallEventData evDat)) = do-    $logDebugS DM._LOGTAG "Run ToolsCallEvent called."--    cmd <- genCommand evDat $ evDat^.DM.paramsMcpToolsCallRequestData^.DM.nameMcpToolsCallRequestDataParams--    cmdQ <- view DM.commandQueueDomainData <$> lift ask-    liftIO $ STM.atomically $ STM.writeTQueue cmdQ cmd--    return noStateTransition-    -    where-      genCommand :: DM.McpToolsCallRequestData -> String -> AppContext DM.Command-      genCommand dat "pty-connect" = genPtyConnectCommand dat-      genCommand dat "pty-bash"    = genPtyConnectCommand dat-      genCommand dat "pty-ssh"     = genPtyConnectCommand dat-      genCommand dat "pty-cabal"   = genPtyConnectCommand dat-      genCommand dat "pty-stack"   = genPtyConnectCommand dat-      genCommand dat "pty-ghci"    = genPtyConnectCommand dat-      genCommand dat "pty-message" = do-        resQ <- view DM.responseQueueDomainData <$> lift ask-        let cmdDat = DM.PtyMessageCommandData {-                      DM._namePtyMessageCommandData = dat^.DM.paramsMcpToolsCallRequestData^.DM.nameMcpToolsCallRequestDataParams-                    , DM._argumentsPtyMessageCommandData = dat^.DM.paramsMcpToolsCallRequestData^.DM.argumentsMcpToolsCallRequestDataParams-                    , DM._callbackPtyMessageCommandData = callback resQ-                    }--        return $ DM.PtyMessageCommand cmdDat-      genCommand dat _ = do-        resQ <- view DM.responseQueueDomainData <$> lift ask-        let cmdDat = DM.SystemCommandData {-                      DM._nameSystemCommandData = dat^.DM.paramsMcpToolsCallRequestData^.DM.nameMcpToolsCallRequestDataParams-                    , DM._argumentsSystemCommandData = dat^.DM.paramsMcpToolsCallRequestData^.DM.argumentsMcpToolsCallRequestDataParams-                    , DM._callbackSystemCommandData = callback resQ-                    }--        return $ DM.SystemCommand cmdDat--      genPtyConnectCommand :: DM.McpToolsCallRequestData -> AppContext DM.Command-      genPtyConnectCommand dat = do-        resQ <- view DM.responseQueueDomainData <$> lift ask-        let cmdDat = DM.PtyConnectCommandData {-                      DM._namePtyConnectCommandData = dat^.DM.paramsMcpToolsCallRequestData^.DM.nameMcpToolsCallRequestDataParams-                    , DM._argumentsPtyConnectCommandData = dat^.DM.paramsMcpToolsCallRequestData^.DM.argumentsMcpToolsCallRequestDataParams-                    , DM._callbackPtyConnectCommandData = callback resQ-                    }--        return $ DM.PtyConnectCommand cmdDat--      -- |-      ---      callback :: STM.TQueue DM.McpResponse -> DM.SystemCommandCallback ()-      callback resQ code outStr errStr = do-        hPutStrLn stderr $ "[INFO] PMS.Domain.Service.DS.State.Run.callback called."--        let jsonRpc = evDat^.DM.jsonrpcMcpToolsCallRequestData-            content = [ DM.McpToolsCallResponseResultContent "text" outStr-                      , DM.McpToolsCallResponseResultContent "text" errStr-                      ]-            result = DM.McpToolsCallResponseResult {-                       DM._contentMcpToolsCallResponseResult = content-                     , DM._isErrorMcpToolsCallResponseResult = (ExitSuccess /= code)-                     }-            resDat = DM.McpToolsCallResponseData jsonRpc result-            res = DM.McpToolsCallResponse resDat--        STM.atomically $ STM.writeTQueue resQ res--        hPutStrLn stderr $ "[INFO] PMS.Domain.Service.DS.State.Run.callback end."

@@ -0,0 +1,137 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}++module PMS.Domain.Service.DS.State.Run.ToolsCall where+++import System.IO+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Logger+import Control.Lens+import Control.Monad.Reader+import qualified Control.Concurrent.STM as STM+import System.Exit++import qualified PMS.Domain.Model.DM.Type as DM+import qualified PMS.Domain.Model.DM.Constant as DM++import PMS.Domain.Service.DM.Type+++-- |+--+instance IStateActivity RunStateData ToolsCallEventData where+  action _ (ToolsCallEvent (ToolsCallEventData evDat)) = do+    $logDebugS DM._LOGTAG "Run ToolsCallEvent called."++    go evDat $ evDat^.DM.paramsMcpToolsCallRequestData^.DM.nameMcpToolsCallRequestDataParams++    return noStateTransition+    +    where+      go :: DM.McpToolsCallRequestData -> String -> AppContext ()+      go dat "pty-connect"   = ptyConnectCommand dat+      go dat "pty-terminate" = ptyTerminateCommand dat+      go dat "pty-message"   = ptyMessageCommand dat+      go dat "pty-bash"      = ptyConnectCommand dat+      go dat "pty-ssh"       = ptyConnectCommand dat+      go dat "pty-cabal"     = ptyConnectCommand dat+      go dat "pty-stack"     = ptyConnectCommand dat+      go dat "pty-ghci"      = ptyConnectCommand dat+      go dat _ = cmdRunCommand dat+++-- |+--+ptyConnectCommand :: DM.McpToolsCallRequestData -> AppContext ()+ptyConnectCommand dat = do+  resQ <- view DM.responseQueueDomainData <$> lift ask+  let cmdDat = DM.PtyConnectCommandData {+                DM._namePtyConnectCommandData      = dat^.DM.paramsMcpToolsCallRequestData^.DM.nameMcpToolsCallRequestDataParams+              , DM._argumentsPtyConnectCommandData = dat^.DM.paramsMcpToolsCallRequestData^.DM.argumentsMcpToolsCallRequestDataParams+              , DM._callbackPtyConnectCommandData  = callback dat resQ+              }++  cmdQ <- view DM.commandQueueDomainData <$> lift ask+  liftIO $ STM.atomically $ STM.writeTQueue cmdQ $ DM.PtyConnectCommand cmdDat+++-- |+--+ptyTerminateCommand :: DM.McpToolsCallRequestData -> AppContext ()+ptyTerminateCommand dat = do+  resQ <- view DM.responseQueueDomainData <$> lift ask+  let cmdDat = DM.PtyTerminateCommandData {+                DM._namePtyTerminateCommandData      = dat^.DM.paramsMcpToolsCallRequestData^.DM.nameMcpToolsCallRequestDataParams+              , DM._argumentsPtyTerminateCommandData = dat^.DM.paramsMcpToolsCallRequestData^.DM.argumentsMcpToolsCallRequestDataParams+              , DM._callbackPtyTerminateCommandData  = callback dat resQ+              }++  cmdQ <- view DM.commandQueueDomainData <$> lift ask+  liftIO $ STM.atomically $ STM.writeTQueue cmdQ $ DM.PtyTerminateCommand cmdDat+++-- |+--+ptyMessageCommand :: DM.McpToolsCallRequestData -> AppContext ()+ptyMessageCommand dat = do+  resQ <- view DM.responseQueueDomainData <$> lift ask+  let cmdDat = DM.PtyMessageCommandData {+                DM._namePtyMessageCommandData      = dat^.DM.paramsMcpToolsCallRequestData^.DM.nameMcpToolsCallRequestDataParams+              , DM._argumentsPtyMessageCommandData = dat^.DM.paramsMcpToolsCallRequestData^.DM.argumentsMcpToolsCallRequestDataParams+              , DM._callbackPtyMessageCommandData  = callback dat resQ+              }++  cmdQ <- view DM.commandQueueDomainData <$> lift ask+  liftIO $ STM.atomically $ STM.writeTQueue cmdQ $ DM.PtyMessageCommand cmdDat+++-- |+--+callback :: DM.McpToolsCallRequestData -> STM.TQueue DM.McpResponse -> DM.SystemCommandCallback ()+callback evDat resQ code outStr errStr = do+  hPutStrLn stderr $ "[INFO] PMS.Domain.Service.DS.State.Run.callback called."++  let jsonRpc = evDat^.DM.jsonrpcMcpToolsCallRequestData+      content = [ DM.McpToolsCallResponseResultContent "text" outStr+                , DM.McpToolsCallResponseResultContent "text" errStr+                ]+      result = DM.McpToolsCallResponseResult {+                  DM._contentMcpToolsCallResponseResult = content+                , DM._isErrorMcpToolsCallResponseResult = (ExitSuccess /= code)+                }+      resDat = DM.McpToolsCallResponseData jsonRpc result+      res = DM.McpToolsCallResponse resDat++  STM.atomically $ STM.writeTQueue resQ res++  hPutStrLn stderr $ "[INFO] PMS.Domain.Service.DS.State.Run.callback end."+++-- |+--+cmdRunCommand :: DM.McpToolsCallRequestData -> AppContext ()+cmdRunCommand dat = do+  {-+  resQ <- view DM.responseQueueDomainData <$> lift ask+  let cmdDat2 = DM.SystemCommandData {+                DM._nameSystemCommandData = dat^.DM.paramsMcpToolsCallRequestData^.DM.nameMcpToolsCallRequestDataParams+              , DM._argumentsSystemCommandData = dat^.DM.paramsMcpToolsCallRequestData^.DM.argumentsMcpToolsCallRequestDataParams+              , DM._callbackSystemCommandData = callback dat resQ+              }++  cmdQ2 <- view DM.commandQueueDomainData <$> lift ask+  -}+  -- liftIO $ STM.atomically $ STM.writeTQueue cmdQ2 $ DM.SystemCommand cmdDat2++  let cmdDat = DM.DefaultCmdRunCommandData {+                DM._jsonrpcDefaultCmdRunCommandData   = dat^.DM.jsonrpcMcpToolsCallRequestData+              , DM._nameDefaultCmdRunCommandData      = dat^.DM.paramsMcpToolsCallRequestData^.DM.nameMcpToolsCallRequestDataParams+              , DM._argumentsDefaultCmdRunCommandData = dat^.DM.paramsMcpToolsCallRequestData^.DM.argumentsMcpToolsCallRequestDataParams+              }++  cmdQ <- view DM.cmdRunQueueDomainData <$> lift ask+  liftIO $ STM.atomically $ STM.writeTQueue cmdQ $ DM.DefaultCmdRunCommand cmdDat

@@ -0,0 +1,46 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}++module PMS.Domain.Service.DS.State.Run.ToolsList where++import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Logger+import qualified Data.Text as T+import Control.Lens+import Control.Monad.Reader+import qualified Control.Concurrent.STM as STM+import System.FilePath++import qualified PMS.Domain.Model.DM.Type as DM+import qualified PMS.Domain.Model.DM.Constant as DM++import PMS.Domain.Service.DM.Type+import qualified PMS.Domain.Service.DS.Utility as U+++-- |+--+instance IStateActivity RunStateData ToolsListEventData where+  action s (ToolsListEvent r@(ToolsListEventData dat)) = do+    $logDebugS DM._LOGTAG "Run ToolsListEvent called."+    $logDebugS DM._LOGTAG (T.pack (show s))+    $logDebugS DM._LOGTAG (T.pack (show r))++    toolsDir <- view DM.toolsDirDomainData <$> lift ask++    let toolFile = toolsDir </> DM._TOOLS_LIST_FILE+    cont <- U.readFile toolFile+    let result = DM.McpToolsListResponseResult $ DM.RawJsonByteString cont+        jsonRpc = dat^.DM.jsonrpcMcpToolsListRequestData+        resDat = DM.McpToolsListResponseData jsonRpc result+        res = DM.McpToolsListResponse resDat++    $logDebugS DM._LOGTAG $ T.pack $ show res++    queue <- view DM.responseQueueDomainData <$> lift ask+    liftIO $ STM.atomically $ STM.writeTQueue queue res++    return noStateTransition

@@ -11,7 +11,8 @@  import PMS.Domain.Service.DM.Type import PMS.Domain.Service.DM.TH-import PMS.Domain.Service.DS.State.Start.Init()+import PMS.Domain.Service.DS.State.Start.Initialize()+import PMS.Domain.Service.DS.State.Start.Initialized() import PMS.Domain.Service.DS.State.Start.Launch() import PMS.Domain.Service.DS.State.Start.Disconnect() import PMS.Domain.Service.DS.State.Start.Terminate()@@ -23,7 +24,7 @@   actionS s (EventW r@EntryEvent{})      = action s r   actionS s (EventW r@ExitEvent{})       = action s r   actionS s (EventW r@TransitEvent{})    = action s r-  actionS s (EventW r@InitEvent{})       = action s r+  actionS s (EventW r@InitializeEvent{})       = action s r   actionS s (EventW r@LaunchEvent{})     = action s r   actionS s (EventW r@DisconnectEvent{}) = action s r   actionS s (EventW r@TerminateEvent{})  = action s r@@ -52,10 +53,21 @@  -- | --+{- instance IStateActivity StartStateData InitializedEventData where   action _ _ = do     $logDebugS DM._LOGTAG "initialized called."++    $logDebugS DM._LOGTAG "start watch tools-list.json."+    let jsonRpc = dat^.DM.jsonrpcMcpToolsListRequestData+        cmdDat = DM.ToolsListWatchCommandData jsonRpc+        cmd = DM.ToolsListWatchCommand cmdDat++    wq <- view DM.watchQueueDomainData <$> lift ask+    liftIO $ STM.atomically $ STM.writeTQueue wq cmd+         return $ Just StartToRun+-}  -- | --

@@ -1,41 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}--module PMS.Domain.Service.DS.State.Start.Init where--import Data.Default-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import Control.Monad.Logger-import Control.Monad.Reader-import Control.Lens-import qualified Data.Text as T-import qualified Control.Concurrent.STM as STM--import qualified PMS.Domain.Model.DM.Type as DM-import qualified PMS.Domain.Model.DM.Constant as DM--import PMS.Domain.Service.DM.Type----- |----instance IStateActivity StartStateData InitEventData where-  action s (InitEvent r@(InitEventData dat)) = do-    $logDebugS DM._LOGTAG "Start init called."-    $logDebugS DM._LOGTAG (T.pack (show s))-    $logDebugS DM._LOGTAG (T.pack (show r))--    let jsonRpc = dat^.DM.jsonrpcMcpInitializeRequestData-        resDat  = DM.McpInitializeResponseData jsonRpc def-        res     = DM.McpInitializeResponse resDat--    $logDebugS DM._LOGTAG $ T.pack $ show res--    queue <- view DM.responseQueueDomainData <$> lift ask-    liftIO $ STM.atomically $ STM.writeTQueue queue res--    return Nothing-

@@ -0,0 +1,41 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}++module PMS.Domain.Service.DS.State.Start.Initialize where++import Data.Default+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Logger+import Control.Monad.Reader+import Control.Lens+import qualified Data.Text as T+import qualified Control.Concurrent.STM as STM++import qualified PMS.Domain.Model.DM.Type as DM+import qualified PMS.Domain.Model.DM.Constant as DM++import PMS.Domain.Service.DM.Type+++-- |+--+instance IStateActivity StartStateData InitializeEventData where+  action s (InitializeEvent r@(InitializeEventData dat)) = do+    $logDebugS DM._LOGTAG "Start init called."+    $logDebugS DM._LOGTAG (T.pack (show s))+    $logDebugS DM._LOGTAG (T.pack (show r))++    let jsonRpc = dat^.DM.jsonrpcMcpInitializeRequestData+        resDat  = DM.McpInitializeResponseData jsonRpc def+        res     = DM.McpInitializeResponse resDat++    $logDebugS DM._LOGTAG $ T.pack $ show res++    queue <- view DM.responseQueueDomainData <$> lift ask+    liftIO $ STM.atomically $ STM.writeTQueue queue res++    return Nothing+

@@ -0,0 +1,34 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}++module PMS.Domain.Service.DS.State.Start.Initialized where++import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Logger+import Control.Monad.Reader+import Control.Lens+import qualified Control.Concurrent.STM as STM++import qualified PMS.Domain.Model.DM.Type as DM+import qualified PMS.Domain.Model.DM.Constant as DM++import PMS.Domain.Service.DM.Type+++-- |+--+instance IStateActivity StartStateData InitializedEventData where+  action _ (InitializedEvent (InitializedEventData _)) = do+    $logDebugS DM._LOGTAG "initialized called."++    $logDebugS DM._LOGTAG "start watch tools-list.json."+    let cmd = DM.ToolsListWatchCommand DM.ToolsListWatchCommandData++    wq <- view DM.watchQueueDomainData <$> lift ask+    liftIO $ STM.atomically $ STM.writeTQueue wq cmd+    +    return $ Just StartToRun+

@@ -37,7 +37,7 @@  -- | ---instance IStateActivity StopStateData InitEventData+instance IStateActivity StopStateData InitializeEventData   -- @see default implementation in Type module.  -- |