pms-domain-service 0.0.4.0 → 0.0.5.0
raw patch · 6 files changed
+93/−11 lines, 6 filesdep ~base
Dependency ranges changed: base
Files
- CHANGELOG.md +4/−0
- pms-domain-service.cabal +11/−9
- src/PMS/Domain/Service/DM/Type.hs +3/−0
- src/PMS/Domain/Service/DS/State/Run/PromptsGet.hs +2/−2
- src/PMS/Domain/Service/DS/State/Run/ToolsCall.hs +72/−0
- src/PMS/Domain/Service/DS/Utility.hs +1/−0
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for pms-domain-service +## 0.0.5.0 -- 2025-07-13++* Added serial tool.+ ## 0.0.4.0 -- 2025-07-06 * Added resources interface.
pms-domain-service.cabal view
@@ -1,4 +1,4 @@-cabal-version: 3.12+cabal-version: 2.4 -- The cabal-version field refers to the version of the .cabal specification, -- and can be different from the cabal-install (the tool) version and the -- Cabal (the library) version you are using. As such, the Cabal (the library)@@ -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-service@@ -56,7 +56,8 @@ library -- Import common warning flags.- ghc-options: -Wall -threaded -Wno-orphans -Wno-x-partial -Wno-gadt-mono-local-binds+-- ghc-options: -Wall -threaded -Wno-orphans -Wno-x-partial -Wno-gadt-mono-local-binds+ ghc-options: -Wall -threaded -Wno-orphans -Wno-gadt-mono-local-binds -- Modules exported by the library. exposed-modules: PMS.Domain.Service.DM.Type,@@ -85,7 +86,7 @@ -- other-extensions: -- Other library packages from which modules are imported.- build-depends: base ^>=4.21.0.0,+ build-depends: base >= 4.18 && < 5, transformers, mtl, text,@@ -110,15 +111,16 @@ hs-source-dirs: src -- Base language which the package is written in.- default-language: GHC2021- default-extensions: LambdaCase+ default-language: Haskell2010+ -- default-extensions: LambdaCase test-suite pms-domain-service-test -- Import common warning flags.- ghc-options: -Wall -threaded -Wno-orphans -Wno-x-partial+ ghc-options: -Wall -threaded -Wno-orphans+-- ghc-options: -Wall -threaded -Wno-orphans -Wno-x-partial -- Base language which the package is written in.- default-language: GHC2021+ default-language: Haskell2010 -- Modules included in this executable, other than Main. other-modules: PMS.Domain.Service.App.ControlSpec@@ -136,7 +138,7 @@ main-is: Spec.hs -- Test dependencies.- build-depends: base ^>=4.21.0.0,+ build-depends: base >= 4.18 && < 5, hspec, hspec-discover, data-default,
src/PMS/Domain/Service/DM/Type.hs view
@@ -1,4 +1,7 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-} module PMS.Domain.Service.DM.Type where
src/PMS/Domain/Service/DS/State/Run/PromptsGet.hs view
@@ -34,11 +34,11 @@ $logDebugS DM._LOGTAG $ T.pack $ "Run PromptsGetEvent called." ++ show evDat let params = evDat^.DM.paramsMcpPromptsGetRequestData- name = params^.DM.nameMcpPromptsGetRequestDataParams+ pname = params^.DM.nameMcpPromptsGetRequestDataParams argsBS = DM.unRawJsonByteString $ params^.DM.argumentsMcpPromptsGetRequestDataParams promptsDir <- view DM.promptsDirDomainData <$> lift ask- let promptsFile = name ++ ".md"+ let promptsFile = pname ++ ".md" promptsFilePath = promptsDir </> promptsFile argsDat <- liftEither $ eitherDecode $ argsBS
src/PMS/Domain/Service/DS/State/Run/ToolsCall.hs view
@@ -56,6 +56,11 @@ go dat "socket-write" = socketWriteCommand dat go dat "socket-message" = socketMessageCommand dat go dat "socket-telnet" = socketTelnetCommand dat+ go dat "serial-open" = serialOpenCommand dat+ go dat "serial-close" = serialCloseCommand dat+ go dat "serial-read" = serialReadCommand dat+ go dat "serial-write" = serialWriteCommand dat+ go dat "serial-message" = serialMessageCommand dat go dat x = do $logDebugS DM._LOGTAG $ T.pack $ "handled cmdrun. " ++ show x ++ ": " ++ show dat cmdRunCommand dat@@ -257,4 +262,71 @@ cmdQ <- view DM.socketQueueDomainData <$> lift ask liftIO $ STM.atomically $ STM.writeTQueue cmdQ $ DM.SocketTelnetCommand cmdDat+++-- |+--+serialOpenCommand :: DM.McpToolsCallRequestData -> AppContext ()+serialOpenCommand dat = do+ let cmdDat = DM.SerialOpenCommandData {+ DM._jsonrpcSerialOpenCommandData = dat^.DM.jsonrpcMcpToolsCallRequestData+ , DM._nameSerialOpenCommandData = dat^.DM.paramsMcpToolsCallRequestData^.DM.nameMcpToolsCallRequestDataParams+ , DM._argumentsSerialOpenCommandData = dat^.DM.paramsMcpToolsCallRequestData^.DM.argumentsMcpToolsCallRequestDataParams+ }++ $logDebugS DM._LOGTAG $ T.pack $ "serialOpenCommand" ++ show cmdDat++ cmdQ <- view DM.serialQueueDomainData <$> lift ask+ liftIO $ STM.atomically $ STM.writeTQueue cmdQ $ DM.SerialOpenCommand cmdDat+++-- |+--+serialCloseCommand :: DM.McpToolsCallRequestData -> AppContext ()+serialCloseCommand dat = do+ let cmdDat = DM.SerialCloseCommandData {+ DM._jsonrpcSerialCloseCommandData = dat^.DM.jsonrpcMcpToolsCallRequestData+ }++ cmdQ <- view DM.serialQueueDomainData <$> lift ask+ liftIO $ STM.atomically $ STM.writeTQueue cmdQ $ DM.SerialCloseCommand cmdDat+++-- |+--+serialReadCommand :: DM.McpToolsCallRequestData -> AppContext ()+serialReadCommand dat = do+ let cmdDat = DM.SerialReadCommandData {+ DM._jsonrpcSerialReadCommandData = dat^.DM.jsonrpcMcpToolsCallRequestData+ , DM._argumentsSerialReadCommandData = dat^.DM.paramsMcpToolsCallRequestData^.DM.argumentsMcpToolsCallRequestDataParams+ }++ cmdQ <- view DM.serialQueueDomainData <$> lift ask+ liftIO $ STM.atomically $ STM.writeTQueue cmdQ $ DM.SerialReadCommand cmdDat+++-- |+--+serialWriteCommand :: DM.McpToolsCallRequestData -> AppContext ()+serialWriteCommand dat = do+ let cmdDat = DM.SerialWriteCommandData {+ DM._jsonrpcSerialWriteCommandData = dat^.DM.jsonrpcMcpToolsCallRequestData+ , DM._argumentsSerialWriteCommandData = dat^.DM.paramsMcpToolsCallRequestData^.DM.argumentsMcpToolsCallRequestDataParams+ }++ cmdQ <- view DM.serialQueueDomainData <$> lift ask+ liftIO $ STM.atomically $ STM.writeTQueue cmdQ $ DM.SerialWriteCommand cmdDat+++-- |+--+serialMessageCommand :: DM.McpToolsCallRequestData -> AppContext ()+serialMessageCommand dat = do+ let cmdDat = DM.SerialMessageCommandData {+ DM._jsonrpcSerialMessageCommandData = dat^.DM.jsonrpcMcpToolsCallRequestData+ , DM._argumentsSerialMessageCommandData = dat^.DM.paramsMcpToolsCallRequestData^.DM.argumentsMcpToolsCallRequestDataParams+ }++ cmdQ <- view DM.serialQueueDomainData <$> lift ask+ liftIO $ STM.atomically $ STM.writeTQueue cmdQ $ DM.SerialMessageCommand cmdDat
src/PMS/Domain/Service/DS/Utility.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE LambdaCase #-} module PMS.Domain.Service.DS.Utility where