pms-infrastructure 0.0.4.0 → 0.0.5.0
raw patch · 4 files changed
+35/−23 lines, 4 filesdep ~base
Dependency ranges changed: base
Files
- CHANGELOG.md +4/−0
- pms-infrastructure.cabal +7/−7
- src/PMS/Infrastructure/App/Control.hs +2/−0
- src/PMS/Infrastructure/DS/Core.hs +22/−16
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for pms-infrastructure +## 0.0.5.0 -- 2025-07-13++* Added serial tool.+ ## 0.0.4.0 -- 2025-06-29 * Added prompts interface.
pms-infrastructure.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-infrastructure@@ -73,7 +73,7 @@ -- other-extensions: -- Other library packages from which modules are imported.- build-depends: base ^>=4.21.0.0,+ build-depends: base >= 4.18 && < 5, data-default, monad-logger, mtl,@@ -99,15 +99,15 @@ 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-infrastructure-test -- Import common warning flags. ghc-options: -Wall -threaded -- 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.Infrastructure.App.ControlSpec@@ -125,7 +125,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/Infrastructure/App/Control.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE LambdaCase #-}+ module PMS.Infrastructure.App.Control where import System.IO
src/PMS/Infrastructure/DS/Core.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-} module PMS.Infrastructure.DS.Core where @@ -143,34 +144,39 @@ procTMVar <- view processHandleAppData <$> ask lockTMVar <- view lockAppData <$> ask - (cmdTmp, argsArrayTmp) <- getCommandArgs name argsBS+ (cmdTmp, argsArrayTmp,addPrompts) <- getCommandArgs name argsBS cmd <- liftIOE $ DM.validateCommand cmdTmp argsArray <- liftIOE $ DM.validateArgs argsArrayTmp $logDebugS DM._LOGTAG $ T.pack $ "ptyConnectTask: cmd. " ++ cmd ++ " " ++ show argsArray - return $ ptyConnectTask ptyTMVar procTMVar lockTMVar cmd argsArray prompts tout callback+ return $ ptyConnectTask ptyTMVar procTMVar lockTMVar cmd argsArray (prompts++addPrompts) tout callback where -- | --- getCommandArgs :: String -> BL.ByteString -> AppContext (String, [String])+ getCommandArgs :: String -> BL.ByteString -> AppContext (String, [String], [String]) getCommandArgs "pty-connect" argsBS = do argsDat <- liftEither $ eitherDecode $ argsBS let argsArray = maybe [] id (argsDat^.argumentsPtyConnectToolParams) cmd = argsDat^.commandPtyConnectToolParams- return (cmd, argsArray)+ return (cmd, argsArray, []) getCommandArgs "pty-bash" argsBS = do argsDat <- liftEither $ eitherDecode $ argsBS let argsArray = argsDat^.argumentsStringArrayToolParams- return ("bash", argsArray)+ return ("bash", argsArray, []) getCommandArgs "pty-ssh" argsBS = do argsDat <- liftEither $ eitherDecode $ argsBS let argsArray = argsDat^.argumentsStringArrayToolParams- return ("ssh", argsArray)+ return ("ssh", argsArray, [")?", "password:"]) + getCommandArgs "pty-telnet" argsBS = do+ argsDat <- liftEither $ eitherDecode $ argsBS+ let argsArray = argsDat^.argumentsStringArrayToolParams+ return ("telnet", argsArray, ["login:", "Password:"])+ getCommandArgs "pty-cabal" argsBS = do argsDat <- liftEither $ eitherDecode $ argsBS let prjDir = argsDat^.projectDirPtySetCwdToolParams@@ -178,7 +184,7 @@ liftIOE $ D.setCurrentDirectory prjDir - return ("cabal", "repl":argsArray)+ return ("cabal", "repl":argsArray, []) getCommandArgs "pty-stack" argsBS = do argsDat <- liftEither $ eitherDecode $ argsBS@@ -187,7 +193,7 @@ liftIOE $ D.setCurrentDirectory prjDir - return ("stack", "repl": argsArray)+ return ("stack", "repl": argsArray, []) getCommandArgs "pty-ghci" argsBS = do argsDat <- liftEither $ eitherDecode $ argsBS@@ -198,7 +204,7 @@ liftIOE $ D.setCurrentDirectory prjDir argsArray <- liftIOE $ getGhciFlagsFromPath prjDir startup - return ("ghc", argsArray ++ addArgs)+ return ("ghc", argsArray ++ addArgs, []) getCommandArgs x _ = throwError $ "getCommand: unsupported command. " ++ x @@ -243,10 +249,10 @@ -- runPty :: IO () runPty = do- let env = Nothing+ let envList = Nothing -- env = Just [("TERM", "dumb")] dim = (80, 24)- (pty, procHdl) <- spawnWithPty env True cmd args dim+ (pty, procHdl) <- spawnWithPty envList True cmd args dim STM.atomically $ STM.putTMVar ptyTMVar (Just pty) _ <- STM.atomically $ STM.swapTMVar procTMVar (Just procHdl) return ()@@ -356,14 +362,14 @@ -- getGhciFlagsFromPath :: FilePath -> Maybe FilePath -> IO [String] getGhciFlagsFromPath prjDir startup = do- let cwd = prjDir+ let prjcwd = prjDir startupFile <- case startup of Just path -> do exists <- D.doesFileExist path- return $ if exists then path else cwd </> "Dummy.hs"- Nothing -> return $ cwd </> "Dummy.hs"+ return $ if exists then path else prjcwd </> "Dummy.hs"+ Nothing -> return $ prjcwd </> "Dummy.hs" - hPutStrLn stderr $ "[INFO] getGhciFlagsFromPath: cwd: " ++ cwd+ hPutStrLn stderr $ "[INFO] getGhciFlagsFromPath: prjcwd: " ++ prjcwd hPutStrLn stderr $ "[INFO] getGhciFlagsFromPath: startupFile: " ++ startupFile explicitCradle <- HIE.findCradle startupFile@@ -380,7 +386,7 @@ hPutStrLn stderr $ "[WARN] Failed to get runtime GHC libdir: " ++ show e return "" - compOptsResult <- D.withCurrentDirectory cwd $+ compOptsResult <- D.withCurrentDirectory prjcwd $ HIE.getCompilerOptions startupFile HIE.LoadFile cradle flags <- case compOptsResult of