pms-infra-filesystem 0.0.1.0 → 0.0.2.0

raw patch · 4 files changed

+86/−1 lines, 4 files

Files

• CHANGELOG.md +4/−0
• pms-infra-filesystem.cabal +1/−1
• src/PMS/Infra/FileSystem/DM/Type.hs +17/−0
• src/PMS/Infra/FileSystem/DS/Core.hs +64/−0

@@ -1,5 +1,9 @@ # Revision history for pms-infra-filesystem +## 0.0.2.0 -- 2026-01-31++* Add file system pms-make-dir tools.+ ## 0.0.1.0 -- 2025-12-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-infra-filesystem

@@ -70,6 +70,23 @@         _pathListDirParams = def       } ++-- |+--+data MakeDirParams =+  MakeDirParams {+    _pathMakeDirParams :: String+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = DM.dropDataName "MakeDirParams", omitNothingFields = True} ''MakeDirParams)+makeLenses ''MakeDirParams++instance Default MakeDirParams where+  def = MakeDirParams {+        _pathMakeDirParams = def+      }++ -- | -- data ReadFileParams =

@@ -77,6 +77,7 @@     go :: DM.FileSystemCommand -> AppContext (IOTask ())     go (DM.EchoFileSystemCommand dat) = genEchoTask dat     go (DM.ListDirFileSystemCommand dat) = genListDirTask dat+    go (DM.MakeDirFileSystemCommand dat) = genMakeDirTask dat     go (DM.ReadFileFileSystemCommand dat) = genReadFileTask dat     go (DM.WriteFileFileSystemCommand dat) = genWriteFileTask dat @@ -212,6 +213,69 @@            , _typeDirEntry  = if isDir then "directory" else "file"            , _sizeDirEntry  = mSize            }+++---------------------------------------------------------------------------------+-- |+--+genMakeDirTask :: DM.MakeDirFileSystemCommandData -> AppContext (IOTask ())+genMakeDirTask dat = do+  let argsBS = DM.unRawJsonByteString+             $ dat^.DM.argumentsMakeDirFileSystemCommandData+  argsDat <- liftEither $ eitherDecode argsBS++  let path = argsDat^.pathMakeDirParams+  abPath <- liftIO $ makeAbsolute path++  resQ <- view DM.responseQueueDomainData <$> lift ask+  sandboxDir <- view DM.sandboxDirDomainData <$> lift ask++  when (not (permitedPath sandboxDir abPath)) $+    throwError $+      "genMakeDirTask: path is not under sandboxDir. path: " ++ abPath++  $logDebugS DM._LOGTAG $+    T.pack $ "makeDirTask: path : " ++ abPath++  return $ makeDirTask resQ dat abPath++-- |+--   +makeDirTask :: STM.TQueue DM.McpResponse+            -> DM.MakeDirFileSystemCommandData+            -> String+            -> IOTask ()+makeDirTask resQ cmdDat path = flip E.catchAny errHdl $ do+  hPutStrLn stderr $+    "[INFO] PMS.Infra.FileSystem.DS.Core.work.makeDirTask run. " ++ path++  -- mkdir -p 相当+  createDirectoryIfMissing True path++  response ExitSuccess path ""++  hPutStrLn stderr+    "[INFO] PMS.Infra.FileSystem.DS.Core.work.makeDirTask end."++  where+    errHdl :: E.SomeException -> IO ()+    errHdl e = response (ExitFailure 1) "" (show e)++    response :: ExitCode -> String -> String -> IO ()+    response code outStr errStr = do+      let jsonRpc = cmdDat^.DM.jsonrpcMakeDirFileSystemCommandData+          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   ---------------------------------------------------------------------------------