diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for pms-application-service +## 0.0.5.0 -- 2025-07-13 + +* Added serial tool. + ## 0.0.4.0 -- 2025-06-29 * Added prompts interface. diff --git a/pms-application-service.cabal b/pms-application-service.cabal --- a/pms-application-service.cabal +++ b/pms-application-service.cabal @@ -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-application-service @@ -57,7 +57,8 @@ library -- Import common warning flags. - ghc-options: -Wall -threaded -Wno-x-partial +-- ghc-options: -Wall -threaded -Wno-x-partial + ghc-options: -Wall -threaded -- Modules exported by the library. exposed-modules: PMS.Application.Service.DM.Type, @@ -74,7 +75,7 @@ -- other-extensions: -- Other library packages from which modules are imported. - build-depends: base ^>=4.21.0.0, + build-depends: base >= 4.18 && < 5, aeson, lens, data-default, @@ -86,21 +87,24 @@ mtl, async, async-pool, + filepath, + directory, pms-domain-model -- Directories containing source files. 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-application-service-test -- Import common warning flags. - ghc-options: -Wall -threaded -Wno-x-partial + ghc-options: -Wall -threaded +-- ghc-options: -Wall -threaded -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.Application.Service.App.ControlSpec @@ -118,7 +122,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, diff --git a/src/PMS/Application/Service/App/Control.hs b/src/PMS/Application/Service/App/Control.hs --- a/src/PMS/Application/Service/App/Control.hs +++ b/src/PMS/Application/Service/App/Control.hs @@ -4,10 +4,14 @@ import qualified Control.Exception.Safe as E import Data.Default +-- import Data.Yaml.Config import Data.Yaml import Control.Lens import System.Log.FastLogger import System.IO +-- import System.Environment +import System.Directory +import System.FilePath import qualified PMS.Domain.Model.DM.Type as DM import qualified PMS.Domain.Model.DS.Utility as DM @@ -26,17 +30,32 @@ run args apps = do hPutStrLn stderr "[INFO] PMS.Application.Service.App.Control.run called." - conf <- maybe (pure def) decodeFileThrow (args^.yamlArgData) + conf <- loadConf args + + changeCWD args conf + + logDir <- case conf^.logDirConfigData of + Nothing -> return Nothing + Just p -> Just <$> makeAbsolute p + toolsDir <- makeAbsolute $ conf^.toolsDirConfigData + promptsDir <- makeAbsolute $ conf^.promptsDirConfigData + resourcesDir <- makeAbsolute $ conf^.resourcesDirConfigData + defDom <- DM.defaultDomainData - hPutStrLn stderr $ "[INFO] PMS.Application.Service.App.Control.run conf." ++ show conf + hPutStrLn stderr $ "[INFO] PMS.Application.Service.App.Control.run args: " ++ show args + hPutStrLn stderr $ "[INFO] PMS.Application.Service.App.Control.run conf: " ++ show conf + hPutStrLn stderr $ "[INFO] PMS.Application.Service.App.Control.run logDir: " ++ show logDir + hPutStrLn stderr $ "[INFO] PMS.Application.Service.App.Control.run toolsDir: " ++ toolsDir + hPutStrLn stderr $ "[INFO] PMS.Application.Service.App.Control.run promptsDir: " ++ promptsDir + hPutStrLn stderr $ "[INFO] PMS.Application.Service.App.Control.run resourcesDir: " ++ resourcesDir let domDat = defDom { - DM._logDirDomainData = conf^.logDirConfigData + DM._logDirDomainData = logDir , DM._logLevelDomainData = conf^.logLevelConfigData - , DM._toolsDirDomainData = conf^.toolsDirConfigData - , DM._promptsDirDomainData = conf^.promptsDirConfigData - , DM._resourcesDirDomainData = conf^.resourcesDirConfigData + , DM._toolsDirDomainData = toolsDir + , DM._promptsDirDomainData = promptsDir + , DM._resourcesDirDomainData = resourcesDir , DM._promptsDomainData = conf^.promptsConfigData } appDat = def { @@ -75,3 +94,35 @@ hPutStrLn stderr "[ERROR] PMS.Application.Service.App.Control.run end with error." hPutStrLn stderr $ show e hPutStrLn stderr "-----------------------------------------------------------------------------" + +-- | +-- +loadConf :: ArgData -> IO ConfigData +loadConf args = maybe (pure def) decodeFileThrow (args^.yamlArgData) +{- +loadConf args = case args ^. yamlArgData of + Nothing -> pure def + Just relPath -> do + absPath <- makeAbsolute relPath + let yamlDir = takeDirectory absPath + setEnv "PMS_YAML_DIR" yamlDir + + loadYamlSettings [absPath] [] useEnv +-} + +-- | +-- +changeCWD :: ArgData -> ConfigData -> IO () +changeCWD args conf = case conf^.workDirConfigData of + Just dir -> do + setCurrentDirectory dir + hPutStrLn stderr $ "[INFO] CWD(config): " ++ dir + + Nothing -> case args^.yamlArgData of + Just relPath -> do + absPath <- takeDirectory <$> makeAbsolute relPath + setCurrentDirectory absPath + hPutStrLn stderr $ "[INFO] CWD(yaml path): " ++ absPath + + Nothing -> return () + diff --git a/src/PMS/Application/Service/DM/Type.hs b/src/PMS/Application/Service/DM/Type.hs --- a/src/PMS/Application/Service/DM/Type.hs +++ b/src/PMS/Application/Service/DM/Type.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} - +{-# LANGUAGE DeriveDataTypeable #-} module PMS.Application.Service.DM.Type where @@ -44,6 +44,7 @@ , _toolsDirConfigData :: FilePath , _promptsDirConfigData :: FilePath , _resourcesDirConfigData :: FilePath + , _workDirConfigData :: Maybe FilePath , _promptsConfigData :: [String] } deriving (Show, Read, Eq) @@ -56,17 +57,17 @@ instance Default ConfigData where def = ConfigData { - _logDirConfigData = Nothing + _logDirConfigData = def , _logLevelConfigData = LevelDebug , _toolsDirConfigData = "./tools" , _promptsDirConfigData = "./prompts" , _resourcesDirConfigData = "./resources" + , _workDirConfigData = def , _promptsConfigData = [ - "> " - , "]#" - , "]$" - , ")?" - , "password:" + ">>>" + , "# " + , "$ " + , "ghci>" ] } diff --git a/src/PMS/Application/Service/DS/Core.hs b/src/PMS/Application/Service/DS/Core.hs --- a/src/PMS/Application/Service/DS/Core.hs +++ b/src/PMS/Application/Service/DS/Core.hs @@ -1,5 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} module PMS.Application.Service.DS.Core where