pms-domain-model 0.0.4.0 → 0.0.5.0
raw patch · 5 files changed
+509/−98 lines, 5 files
Files
- CHANGELOG.md +4/−0
- pms-domain-model.cabal +1/−1
- src/PMS/Domain/Model/DM/Constant.hs +19/−0
- src/PMS/Domain/Model/DM/Type.hs +455/−95
- src/PMS/Domain/Model/DS/Utility.hs +30/−2
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for pms-domain-model +## 0.0.5.0 -- 2025-07-06++* Added socket tool.+ ## 0.0.4.0 -- 2025-06-29 * Added prompts interface.
pms-domain-model.cabal view
@@ -20,7 +20,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.0.4.0+version: 0.0.5.0 -- A short (one-line) description of the package. synopsis: pms-domain-model
src/PMS/Domain/Model/DM/Constant.hs view
@@ -17,6 +17,11 @@ -- | --+_TIMEOUT_MICROSEC :: Int+_TIMEOUT_MICROSEC = 30 * 1000 * 1000++-- |+-- _TOOLS_LIST_FILE :: String _TOOLS_LIST_FILE = "tools-list.json" @@ -25,9 +30,23 @@ _PROMPTS_LIST_FILE :: String _PROMPTS_LIST_FILE = "prompts-list.json" +-- |+--+_RESOURCES_LIST_FILE :: String+_RESOURCES_LIST_FILE = "resources-list.json" -- | --+_RESOURCES_TPL_LIST_FILE :: String+_RESOURCES_TPL_LIST_FILE = "resources-templates-list.json"++-- |+-- _LF :: String _LF = "\n"++-- |+--+_CRLF :: String+_CRLF = "\r\n"
src/PMS/Domain/Model/DM/Type.hs view
@@ -240,10 +240,112 @@ _jsonrpcMcpPromptsListRequestData = def } +-- |+--+data McpPromptsGetRequestDataParams =+ McpPromptsGetRequestDataParams {+ _nameMcpPromptsGetRequestDataParams :: String+ , _argumentsMcpPromptsGetRequestDataParams :: RawJsonByteString+ } deriving (Show, Read, Eq) +$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpPromptsGetRequestDataParams", omitNothingFields = True} ''McpPromptsGetRequestDataParams)+makeLenses ''McpPromptsGetRequestDataParams +instance Default McpPromptsGetRequestDataParams where+ def = McpPromptsGetRequestDataParams {+ _nameMcpPromptsGetRequestDataParams = def+ , _argumentsMcpPromptsGetRequestDataParams = def+ }+ -- | --+data McpPromptsGetRequestData =+ McpPromptsGetRequestData {+ _jsonrpcMcpPromptsGetRequestData :: JsonRpcRequest+ , _paramsMcpPromptsGetRequestData :: McpPromptsGetRequestDataParams+ } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpPromptsGetRequestData", omitNothingFields = True} ''McpPromptsGetRequestData)+makeLenses ''McpPromptsGetRequestData++instance Default McpPromptsGetRequestData where+ def = McpPromptsGetRequestData {+ _jsonrpcMcpPromptsGetRequestData = def+ , _paramsMcpPromptsGetRequestData = def+ }++++++-- |+--+data McpResourcesTemplatesListRequestData =+ McpResourcesTemplatesListRequestData {+ _jsonrpcMcpResourcesTemplatesListRequestData :: JsonRpcRequest+ } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpResourcesTemplatesListRequestData", omitNothingFields = True} ''McpResourcesTemplatesListRequestData)+makeLenses ''McpResourcesTemplatesListRequestData++instance Default McpResourcesTemplatesListRequestData where+ def = McpResourcesTemplatesListRequestData {+ _jsonrpcMcpResourcesTemplatesListRequestData = def+ }+++-- |+--+data McpResourcesListRequestData =+ McpResourcesListRequestData {+ _jsonrpcMcpResourcesListRequestData :: JsonRpcRequest+ } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpResourcesListRequestData", omitNothingFields = True} ''McpResourcesListRequestData)+makeLenses ''McpResourcesListRequestData++instance Default McpResourcesListRequestData where+ def = McpResourcesListRequestData {+ _jsonrpcMcpResourcesListRequestData = def+ }++-- |+--+data McpResourcesReadRequestDataParams =+ McpResourcesReadRequestDataParams {+ _uriMcpResourcesReadRequestDataParams :: String+ } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpResourcesReadRequestDataParams", omitNothingFields = True} ''McpResourcesReadRequestDataParams)+makeLenses ''McpResourcesReadRequestDataParams++instance Default McpResourcesReadRequestDataParams where+ def = McpResourcesReadRequestDataParams {+ _uriMcpResourcesReadRequestDataParams = def+ }++-- |+--+data McpResourcesReadRequestData =+ McpResourcesReadRequestData {+ _jsonrpcMcpResourcesReadRequestData :: JsonRpcRequest+ , _paramsMcpResourcesReadRequestData :: McpResourcesReadRequestDataParams+ } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpResourcesReadRequestData", omitNothingFields = True} ''McpResourcesReadRequestData)+makeLenses ''McpResourcesReadRequestData++instance Default McpResourcesReadRequestData where+ def = McpResourcesReadRequestData {+ _jsonrpcMcpResourcesReadRequestData = def+ , _paramsMcpResourcesReadRequestData = def+ }+++++-- |+-- data McpInitializedNotificationData = McpInitializedNotificationData { _jsonrpcMcpInitializedNotificationData :: JsonRpcRequest@@ -331,50 +433,18 @@ -- | ---data McpPromptsGetRequestDataParams =- McpPromptsGetRequestDataParams {- _nameMcpPromptsGetRequestDataParams :: String- , _argumentsMcpPromptsGetRequestDataParams :: RawJsonByteString- } deriving (Show, Read, Eq)--$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpPromptsGetRequestDataParams", omitNothingFields = True} ''McpPromptsGetRequestDataParams)-makeLenses ''McpPromptsGetRequestDataParams--instance Default McpPromptsGetRequestDataParams where- def = McpPromptsGetRequestDataParams {- _nameMcpPromptsGetRequestDataParams = def- , _argumentsMcpPromptsGetRequestDataParams = def- }----- |----data McpPromptsGetRequestData =- McpPromptsGetRequestData {- _jsonrpcMcpPromptsGetRequestData :: JsonRpcRequest- , _paramsMcpPromptsGetRequestData :: McpPromptsGetRequestDataParams- } deriving (Show, Read, Eq)--$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpPromptsGetRequestData", omitNothingFields = True} ''McpPromptsGetRequestData)-makeLenses ''McpPromptsGetRequestData--instance Default McpPromptsGetRequestData where- def = McpPromptsGetRequestData {- _jsonrpcMcpPromptsGetRequestData = def- , _paramsMcpPromptsGetRequestData = def- }---- |--- data McpRequest = McpInitializeRequest McpInitializeRequestData | McpToolsListRequest McpToolsListRequestData | McpToolsCallRequest McpToolsCallRequestData | McpPromptsListRequest McpPromptsListRequestData+ | McpPromptsGetRequest McpPromptsGetRequestData+ | McpResourcesTemplatesListRequest McpResourcesTemplatesListRequestData+ | McpResourcesListRequest McpResourcesListRequestData+ | McpResourcesReadRequest McpResourcesReadRequestData | McpInitializedNotification McpInitializedNotificationData | McpCancelledNotification McpCancelledNotificationData | McpCompletionCompleteRequest McpCompletionCompleteRequestData- | McpPromptsGetRequest McpPromptsGetRequestData deriving (Show, Read, Eq) --------------------------------------------------------------------------------@@ -390,7 +460,7 @@ instance Default McpInitializeResponseResultCapabilitiesResources where def = McpInitializeResponseResultCapabilitiesResources {- _subscribedMcpInitializeResponseResultCapabilitiesResources = True+ _subscribedMcpInitializeResponseResultCapabilitiesResources = False , _listChangedMcpInitializeResponseResultCapabilitiesResources = True } @@ -427,7 +497,7 @@ McpInitializeResponseResultCapabilities { _toolsMcpInitializeResponseResultCapabilities :: McpInitializeResponseResultCapabilitiesTools , _promptsMcpInitializeResponseResultCapabilities :: McpInitializeResponseResultCapabilitiesPrompts- -- , _resourcesMcpInitializeResponseResultCapabilities :: McpInitializeResponseResultCapabilitiesResources+ , _resourcesMcpInitializeResponseResultCapabilities :: McpInitializeResponseResultCapabilitiesResources } deriving (Show, Read, Eq) $(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpInitializeResponseResultCapabilities", omitNothingFields = True} ''McpInitializeResponseResultCapabilities) makeLenses ''McpInitializeResponseResultCapabilities@@ -436,7 +506,7 @@ def = McpInitializeResponseResultCapabilities { _toolsMcpInitializeResponseResultCapabilities = def , _promptsMcpInitializeResponseResultCapabilities = def- -- , _resourcesMcpInitializeResponseResultCapabilities = def+ , _resourcesMcpInitializeResponseResultCapabilities = def } -- |@@ -451,8 +521,8 @@ instance Default McpInitializeResponseResultServerInfo where def = McpInitializeResponseResultServerInfo {- _nameMcpInitializeResponseResultServerInfo = def- , _versionMcpInitializeResponseResultServerInfo = def+ _nameMcpInitializeResponseResultServerInfo = "pty-mcp-server"+ , _versionMcpInitializeResponseResultServerInfo = "0.0.4" } -- |@@ -470,7 +540,7 @@ instance Default McpInitializeResponseResult where def = McpInitializeResponseResult {- _protocolVersionMcpInitializeResponseResult = def+ _protocolVersionMcpInitializeResponseResult = "2024-11-05" , _capabilitiesMcpInitializeResponseResult = def , _serverInfoMcpInitializeResponseResult = def , _instructionsMcpInitializeResponseResult = def@@ -616,11 +686,166 @@ , _resultMcpPromptsListResponseData = def } +-- |+--+data McpPromptsGetResponseResultPromptMessage =+ McpPromptsGetResponseResultPromptMessage {+ _roleMcpPromptsGetResponseResultPromptMessage :: String+ , _contentMcpPromptsGetResponseResultPromptMessage :: RawJsonByteString+ } deriving (Show, Read, Eq) +$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpPromptsGetResponseResultPromptMessage", omitNothingFields = True} ''McpPromptsGetResponseResultPromptMessage)+makeLenses ''McpPromptsGetResponseResultPromptMessage +instance Default McpPromptsGetResponseResultPromptMessage where+ def = McpPromptsGetResponseResultPromptMessage {+ _roleMcpPromptsGetResponseResultPromptMessage = "assistant"+ , _contentMcpPromptsGetResponseResultPromptMessage = def+ } -- | --+data McpPromptsGetResponseResult =+ McpPromptsGetResponseResult {+ _messagesMcpPromptsGetResponseResult :: [McpPromptsGetResponseResultPromptMessage]+ } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpPromptsGetResponseResult", omitNothingFields = True} ''McpPromptsGetResponseResult)+makeLenses ''McpPromptsGetResponseResult++instance Default McpPromptsGetResponseResult where+ def = McpPromptsGetResponseResult {+ _messagesMcpPromptsGetResponseResult = def+ }++-- |+--+data McpPromptsGetResponseData =+ McpPromptsGetResponseData {+ _jsonrpcMcpPromptsGetResponseData :: JsonRpcRequest+ , _resultMcpPromptsGetResponseData :: McpPromptsGetResponseResult+ } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpPromptsGetResponseData", omitNothingFields = True} ''McpPromptsGetResponseData)+makeLenses ''McpPromptsGetResponseData++instance Default McpPromptsGetResponseData where+ def = McpPromptsGetResponseData {+ _jsonrpcMcpPromptsGetResponseData = def+ , _resultMcpPromptsGetResponseData = def+ }++++++-- |+--+data McpResourcesTemplatesListResponseResult =+ McpResourcesTemplatesListResponseResult {+ _resourcesMcpResourcesTemplatesListResponseResult :: RawJsonByteString+ } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpResourcesTemplatesListResponseResult", omitNothingFields = True} ''McpResourcesTemplatesListResponseResult)+makeLenses ''McpResourcesTemplatesListResponseResult++instance Default McpResourcesTemplatesListResponseResult where+ def = McpResourcesTemplatesListResponseResult {+ _resourcesMcpResourcesTemplatesListResponseResult = def+ }++-- |+--+data McpResourcesTemplatesListResponseData =+ McpResourcesTemplatesListResponseData {+ _jsonrpcMcpResourcesTemplatesListResponseData :: JsonRpcRequest+ , _resultMcpResourcesTemplatesListResponseData :: McpResourcesTemplatesListResponseResult+ } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpResourcesTemplatesListResponseData", omitNothingFields = True} ''McpResourcesTemplatesListResponseData)+makeLenses ''McpResourcesTemplatesListResponseData++instance Default McpResourcesTemplatesListResponseData where+ def = McpResourcesTemplatesListResponseData {+ _jsonrpcMcpResourcesTemplatesListResponseData = def+ , _resultMcpResourcesTemplatesListResponseData = def+ }++++-- |+--+data McpResourcesListResponseResult =+ McpResourcesListResponseResult {+ _resourcesMcpResourcesListResponseResult :: RawJsonByteString+ } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpResourcesListResponseResult", omitNothingFields = True} ''McpResourcesListResponseResult)+makeLenses ''McpResourcesListResponseResult++instance Default McpResourcesListResponseResult where+ def = McpResourcesListResponseResult {+ _resourcesMcpResourcesListResponseResult = def+ }++-- |+--+data McpResourcesListResponseData =+ McpResourcesListResponseData {+ _jsonrpcMcpResourcesListResponseData :: JsonRpcRequest+ , _resultMcpResourcesListResponseData :: McpResourcesListResponseResult+ } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpResourcesListResponseData", omitNothingFields = True} ''McpResourcesListResponseData)+makeLenses ''McpResourcesListResponseData++instance Default McpResourcesListResponseData where+ def = McpResourcesListResponseData {+ _jsonrpcMcpResourcesListResponseData = def+ , _resultMcpResourcesListResponseData = def+ }++++++-- |+--+data McpResourcesReadResponseResult =+ McpResourcesReadResponseResult {+ _contentsMcpResourcesReadResponseResult :: [RawJsonByteString]+ } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpResourcesReadResponseResult", omitNothingFields = True} ''McpResourcesReadResponseResult)+makeLenses ''McpResourcesReadResponseResult++instance Default McpResourcesReadResponseResult where+ def = McpResourcesReadResponseResult {+ _contentsMcpResourcesReadResponseResult = def+ }++-- |+--+data McpResourcesReadResponseData =+ McpResourcesReadResponseData {+ _jsonrpcMcpResourcesReadResponseData :: JsonRpcRequest+ , _resultMcpResourcesReadResponseData :: McpResourcesReadResponseResult+ } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpResourcesReadResponseData", omitNothingFields = True} ''McpResourcesReadResponseData)+makeLenses ''McpResourcesReadResponseData++instance Default McpResourcesReadResponseData where+ def = McpResourcesReadResponseData {+ _jsonrpcMcpResourcesReadResponseData = def+ , _resultMcpResourcesReadResponseData = def+ }+++++-- |+-- data McpCompleteResponseResult = McpCompleteResponseResult { _valuesMcpCompleteResponseResult :: [String]@@ -671,64 +896,54 @@ -- | ---data McpPromptsGetResponseResultPromptMessage =- McpPromptsGetResponseResultPromptMessage {- _roleMcpPromptsGetResponseResultPromptMessage :: String- , _contentMcpPromptsGetResponseResultPromptMessage :: RawJsonByteString+data TextResourceContents =+ TextResourceContents {+ _uriTextResourceContents :: String+ , _mimeTypeTextResourceContents :: Maybe String+ , _textTextResourceContents :: String } deriving (Show, Read, Eq) -$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpPromptsGetResponseResultPromptMessage", omitNothingFields = True} ''McpPromptsGetResponseResultPromptMessage)-makeLenses ''McpPromptsGetResponseResultPromptMessage+$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "TextResourceContents", omitNothingFields = True} ''TextResourceContents)+makeLenses ''TextResourceContents -instance Default McpPromptsGetResponseResultPromptMessage where- def = McpPromptsGetResponseResultPromptMessage {- _roleMcpPromptsGetResponseResultPromptMessage = "assistant"- , _contentMcpPromptsGetResponseResultPromptMessage = def+instance Default TextResourceContents where+ def = TextResourceContents {+ _uriTextResourceContents = def+ , _mimeTypeTextResourceContents = def+ , _textTextResourceContents = def } - -- | ---data McpPromptsGetResponseResult =- McpPromptsGetResponseResult {- _messagesMcpPromptsGetResponseResult :: [McpPromptsGetResponseResultPromptMessage]+data BlobResourceContents =+ BlobResourceContents {+ _uriBlobResourceContents :: String+ , _mimeTypeBlobResourceContents :: Maybe String+ , _blobResourceContents :: String } deriving (Show, Read, Eq) -$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpPromptsGetResponseResult", omitNothingFields = True} ''McpPromptsGetResponseResult)-makeLenses ''McpPromptsGetResponseResult+$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "BlobResourceContents", omitNothingFields = True} ''BlobResourceContents)+makeLenses ''BlobResourceContents -instance Default McpPromptsGetResponseResult where- def = McpPromptsGetResponseResult {- _messagesMcpPromptsGetResponseResult = def+instance Default BlobResourceContents where+ def = BlobResourceContents {+ _uriBlobResourceContents = def+ , _mimeTypeBlobResourceContents = def+ , _blobResourceContents = def } -- | ---data McpPromptsGetResponseData =- McpPromptsGetResponseData {- _jsonrpcMcpPromptsGetResponseData :: JsonRpcRequest- , _resultMcpPromptsGetResponseData :: McpPromptsGetResponseResult- } deriving (Show, Read, Eq)--$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpPromptsGetResponseData", omitNothingFields = True} ''McpPromptsGetResponseData)-makeLenses ''McpPromptsGetResponseData--instance Default McpPromptsGetResponseData where- def = McpPromptsGetResponseData {- _jsonrpcMcpPromptsGetResponseData = def- , _resultMcpPromptsGetResponseData = def- }----- |--- data McpResponse = McpInitializeResponse McpInitializeResponseData | McpToolsListResponse McpToolsListResponseData | McpToolsCallResponse McpToolsCallResponseData | McpPromptsListResponse McpPromptsListResponseData- | McpCompleteResponse McpCompleteResponseData | McpPromptsGetResponse McpPromptsGetResponseData+ | McpResourcesTemplatesListResponse McpResourcesTemplatesListResponseData+ | McpResourcesListResponse McpResourcesListResponseData+ | McpResourcesReadResponse McpResourcesReadResponseData+ | McpCompleteResponse McpCompleteResponseData deriving (Show, Read, Eq) --------------------------------------------------------------------------------@@ -769,7 +984,7 @@ -- data McpPromptsListChangedNotificationDataParams = McpPromptsListChangedNotificationDataParams {- _promptsMcpPromptsListChangedNotificationDataParams :: RawJsonByteString+ _promptsMcpPromptsListChangedNotificationDataParams :: RawJsonByteString -- prompts-list } deriving (Show, Read, Eq) $(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpPromptsListChangedNotificationDataParams", omitNothingFields = True} ''McpPromptsListChangedNotificationDataParams)@@ -777,7 +992,7 @@ instance Default McpPromptsListChangedNotificationDataParams where def = McpPromptsListChangedNotificationDataParams {- _promptsMcpPromptsListChangedNotificationDataParams = RawJsonByteString "[]"+ _promptsMcpPromptsListChangedNotificationDataParams = RawJsonByteString "[]" -- prompts-list } -- |@@ -797,11 +1012,47 @@ , _paramsMcpPromptsListChangedNotificationData = def } +++ -- | --+data McpResourcesListChangedNotificationDataParams =+ McpResourcesListChangedNotificationDataParams {+ _resourcesMcpResourcesListChangedNotificationDataParams :: RawJsonByteString -- resources-list+ } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpResourcesListChangedNotificationDataParams", omitNothingFields = True} ''McpResourcesListChangedNotificationDataParams)+makeLenses ''McpResourcesListChangedNotificationDataParams++instance Default McpResourcesListChangedNotificationDataParams where+ def = McpResourcesListChangedNotificationDataParams {+ _resourcesMcpResourcesListChangedNotificationDataParams = RawJsonByteString "[]" -- resources-list+ }++-- |+--+data McpResourcesListChangedNotificationData =+ McpResourcesListChangedNotificationData {+ _methodMcpResourcesListChangedNotificationData :: String+ , _paramsMcpResourcesListChangedNotificationData :: McpResourcesListChangedNotificationDataParams+ } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "McpResourcesListChangedNotificationData", omitNothingFields = True} ''McpResourcesListChangedNotificationData)+makeLenses ''McpResourcesListChangedNotificationData++instance Default McpResourcesListChangedNotificationData where+ def = McpResourcesListChangedNotificationData {+ _methodMcpResourcesListChangedNotificationData = "notifications/resources/list_changed"+ , _paramsMcpResourcesListChangedNotificationData = def+ }++-- |+-- data McpNotification = McpToolsListChangedNotification McpToolsListChangedNotificationData | McpPromptsListChangedNotification McpPromptsListChangedNotificationData+ | McpResourcesListChangedNotification McpResourcesListChangedNotificationData deriving (Show, Read, Eq) --------------------------------------------------------------------------------@@ -924,19 +1175,27 @@ makeLenses ''PromptsListWatchCommandData +-- |+--+data ResourcesListWatchCommandData =+ ResourcesListWatchCommandData {+ } deriving (Show, Read, Eq) +makeLenses ''ResourcesListWatchCommandData++ -- | -- data WatchCommand = EchoWatchCommand EchoWatchCommandData | ToolsListWatchCommand ToolsListWatchCommandData | PromptsListWatchCommand PromptsListWatchCommandData+ | ResourcesListWatchCommand ResourcesListWatchCommandData deriving (Show, Read, Eq) --------------------------------------------------------------------------------- -- | -- data ProcEchoCommandData =@@ -996,9 +1255,107 @@ getJsonRpcProcSpawnCommand (ProcTerminateCommand d) = d^.jsonrpcProcTerminateCommandData getJsonRpcProcSpawnCommand (ProcMessageCommand d) = d^.jsonrpcProcMessageCommandData + -------------------------------------------------------------------------------- -- | --+data SocketEchoCommandData =+ SocketEchoCommandData {+ _jsonrpcSocketEchoCommandData :: JsonRpcRequest+ , _valueSocketEchoCommandData :: String+ } deriving (Show, Read, Eq)++makeLenses ''SocketEchoCommandData++-- |+--+data SocketOpenCommandData =+ SocketOpenCommandData {+ _jsonrpcSocketOpenCommandData :: JsonRpcRequest+ , _nameSocketOpenCommandData :: String+ , _argumentsSocketOpenCommandData :: RawJsonByteString+ } deriving (Show, Read, Eq)++makeLenses ''SocketOpenCommandData+++-- |+--+data SocketTelnetCommandData =+ SocketTelnetCommandData {+ _jsonrpcSocketTelnetCommandData :: JsonRpcRequest+ , _nameSocketTelnetCommandData :: String+ , _argumentsSocketTelnetCommandData :: RawJsonByteString+ } deriving (Show, Read, Eq)++makeLenses ''SocketTelnetCommandData++-- |+--+data SocketCloseCommandData =+ SocketCloseCommandData {+ _jsonrpcSocketCloseCommandData :: JsonRpcRequest+ } deriving (Show, Read, Eq)+ +makeLenses ''SocketCloseCommandData+++-- |+--+data SocketReadCommandData =+ SocketReadCommandData {+ _jsonrpcSocketReadCommandData :: JsonRpcRequest+ , _argumentsSocketReadCommandData :: RawJsonByteString+ } deriving (Show, Read, Eq)+ +makeLenses ''SocketReadCommandData++-- |+--+data SocketWriteCommandData =+ SocketWriteCommandData {+ _jsonrpcSocketWriteCommandData :: JsonRpcRequest+ , _argumentsSocketWriteCommandData :: RawJsonByteString+ } deriving (Show, Read, Eq)++makeLenses ''SocketWriteCommandData+++-- |+--+data SocketMessageCommandData =+ SocketMessageCommandData {+ _jsonrpcSocketMessageCommandData :: JsonRpcRequest+ , _argumentsSocketMessageCommandData :: RawJsonByteString+ } deriving (Show, Read, Eq)++makeLenses ''SocketMessageCommandData++-- |+--+data SocketCommand =+ SocketEchoCommand SocketEchoCommandData+ | SocketOpenCommand SocketOpenCommandData+ | SocketCloseCommand SocketCloseCommandData+ | SocketReadCommand SocketReadCommandData+ | SocketWriteCommand SocketWriteCommandData+ | SocketMessageCommand SocketMessageCommandData+ | SocketTelnetCommand SocketTelnetCommandData+ deriving (Show, Read, Eq)++-- |+--+{-+getJsonRpcSocketCommand :: SocketCommand -> JsonRpcRequest+getJsonRpcSocketCommand (SocketEchoCommand d) = d^.jsonrpcSocketEchoCommandData+getJsonRpcSocketCommand (SocketOpenCommand d) = d^.jsonrpcSocketOpenCommandData+getJsonRpcSocketCommand (SocketCloseCommand d) = d^.jsonrpcSocketCloseCommandData+getJsonRpcSocketCommand (SocketMessageCommand d) = d^.jsonrpcSocketMessageCommandData+-}++--------------------------------------------------------------------------------+-- |+-- data DomainData = DomainData { _logDirDomainData :: Maybe String , _logLevelDomainData :: LogLevel@@ -1012,6 +1369,7 @@ , _cmdRunQueueDomainData :: TQueue CmdRunCommand , _watchQueueDomainData :: TQueue WatchCommand , _procspawnQueueDomainData :: TQueue ProcSpawnCommand+ , _socketQueueDomainData :: TQueue SocketCommand , _promptsDomainData :: [String] } @@ -1035,20 +1393,22 @@ cmdRunQ <- newTQueueIO watchQ <- newTQueueIO procQ <- newTQueueIO+ socketQ <- newTQueueIO return DomainData {- _logDirDomainData = Nothing- , _logLevelDomainData = LevelDebug- , _toolsDirDomainData = "./tools"- , _promptsDirDomainData = "./prompts"- , _resourcesDirDomainData = "./resources"- , _requestQueueDomainData = reqQ- , _responseQueueDomainData = resQ+ _logDirDomainData = Nothing+ , _logLevelDomainData = LevelDebug+ , _toolsDirDomainData = "./tools"+ , _promptsDirDomainData = "./prompts"+ , _resourcesDirDomainData = "./resources"+ , _requestQueueDomainData = reqQ+ , _responseQueueDomainData = resQ , _notificationQueueDomainData = notQ- , _commandQueueDomainData = cmdQ- , _cmdRunQueueDomainData = cmdRunQ- , _watchQueueDomainData = watchQ- , _procspawnQueueDomainData = procQ- , _promptsDomainData = def+ , _commandQueueDomainData = cmdQ+ , _cmdRunQueueDomainData = cmdRunQ+ , _watchQueueDomainData = watchQ+ , _procspawnQueueDomainData = procQ+ , _socketQueueDomainData = socketQ+ , _promptsDomainData = def } -- |
src/PMS/Domain/Model/DS/Utility.hs view
@@ -21,6 +21,7 @@ import qualified Data.Text.Encoding.Error as TEE import qualified Control.Concurrent.STM as STM import System.IO+import Data.List import PMS.Domain.Model.DM.Type import PMS.Domain.Model.DM.Constant@@ -186,6 +187,32 @@ readUntilPrompt :: IO BS.ByteString -> [String] -> IO BS.ByteString readUntilPrompt feed prompts = go BS.empty where+ (negativePrompts, positivePrompts) = partition (\s -> not (null s) && head s == '!') prompts+ promptBsList = map BS.pack $ filter (not . null) $ map (dropWhile (== '!')) positivePrompts+ rejectPromptBs = map BS.pack $ map (drop 1) negativePrompts++ foundPrompt acc =+ any (`BS.isInfixOf` acc) promptBsList &&+ all (not . (`BS.isInfixOf` acc)) rejectPromptBs++ go acc = do+ chunk <- feed+ when ("\ESC[6n" `BS.isInfixOf` chunk) $+ E.throwString "Unsupported: Detected cursor position report request (ESC[6n)."++ let txt = TE.decodeUtf8With TEE.lenientDecode chunk+ hPutStrLn stderr $ "[INFO] chunk:\n" ++ T.unpack txt++ let acc' = BS.append acc chunk+ if foundPrompt acc'+ then return acc'+ else go acc'+++{-+readUntilPrompt :: IO BS.ByteString -> [String] -> IO BS.ByteString+readUntilPrompt feed prompts = go BS.empty+ where promptBsList = map BS.pack prompts foundPrompt acc = any (`BS.isInfixOf` acc) promptBsList@@ -195,7 +222,8 @@ when ("\ESC[6n" `BS.isInfixOf` chunk) $ do E.throwString "Unsupported: Detected cursor position report request (ESC[6n)." - let txt = ANSI.stripAnsiEscapeCodes $ TE.decodeUtf8With TEE.lenientDecode chunk+ -- let txt = ANSI.stripAnsiEscapeCodes $ TE.decodeUtf8With TEE.lenientDecode chunk+ let txt = TE.decodeUtf8With TEE.lenientDecode chunk hPutStrLn stderr $ "[INFO] chunk:\n" ++ T.unpack txt let acc' = BS.append acc chunk@@ -204,7 +232,7 @@ else go acc' -{-+ readUntilPrompt :: Pty -> [String] -> IO BS.ByteString readUntilPrompt pms prompts = go BS.empty T.empty where