mirror of
https://github.com/ilyakooo0/vty.git
synced 2024-10-04 03:07:07 +03:00
BuildWidthTable: add command-line flag to control which configuration file is updated
This commit is contained in:
parent
c204e6dd21
commit
63746c65e7
@ -26,6 +26,7 @@ data Arg = Help
|
|||||||
| OutputPath String
|
| OutputPath String
|
||||||
| TableUpperBound String
|
| TableUpperBound String
|
||||||
| UpdateConfig
|
| UpdateConfig
|
||||||
|
| VtyConfigPath String
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
options :: Config -> [OptDescr Arg]
|
options :: Config -> [OptDescr Arg]
|
||||||
@ -40,12 +41,16 @@ options config =
|
|||||||
fromMaybe "<none>" (configOutputPath config) <> ")")
|
fromMaybe "<none>" (configOutputPath config) <> ")")
|
||||||
, Option "u" ["update-config"] (NoArg UpdateConfig)
|
, Option "u" ["update-config"] (NoArg UpdateConfig)
|
||||||
"Create or update the Vty configuration file to use the new map (default: no)"
|
"Create or update the Vty configuration file to use the new map (default: no)"
|
||||||
|
, Option "c" ["config-path"] (ReqArg VtyConfigPath "PATH")
|
||||||
|
("Update the specified Vty configuration file path when -u is set (default: " <>
|
||||||
|
configPath config <> ")")
|
||||||
]
|
]
|
||||||
|
|
||||||
data Config =
|
data Config =
|
||||||
Config { configOutputPath :: Maybe FilePath
|
Config { configOutputPath :: Maybe FilePath
|
||||||
, configBound :: Char
|
, configBound :: Char
|
||||||
, configUpdate :: Bool
|
, configUpdate :: Bool
|
||||||
|
, configPath :: FilePath
|
||||||
}
|
}
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
@ -54,6 +59,7 @@ mkDefaultConfig = do
|
|||||||
Config <$> terminalWidthTablePath
|
Config <$> terminalWidthTablePath
|
||||||
<*> pure defaultUnicodeTableUpperBound
|
<*> pure defaultUnicodeTableUpperBound
|
||||||
<*> pure False
|
<*> pure False
|
||||||
|
<*> vtyConfigPath
|
||||||
|
|
||||||
usage :: IO ()
|
usage :: IO ()
|
||||||
usage = do
|
usage = do
|
||||||
@ -74,6 +80,8 @@ updateConfigFromArg Help c =
|
|||||||
c
|
c
|
||||||
updateConfigFromArg UpdateConfig c =
|
updateConfigFromArg UpdateConfig c =
|
||||||
c { configUpdate = True }
|
c { configUpdate = True }
|
||||||
|
updateConfigFromArg (VtyConfigPath p) c =
|
||||||
|
c { configPath = p }
|
||||||
updateConfigFromArg (TableUpperBound s) c =
|
updateConfigFromArg (TableUpperBound s) c =
|
||||||
case readMaybe s of
|
case readMaybe s of
|
||||||
Nothing -> error $ "Invalid table upper bound: " <> show s
|
Nothing -> error $ "Invalid table upper bound: " <> show s
|
||||||
@ -113,20 +121,19 @@ main = do
|
|||||||
|
|
||||||
when (configUpdate config) $ do
|
when (configUpdate config) $ do
|
||||||
Just tName <- currentTerminalName
|
Just tName <- currentTerminalName
|
||||||
configPath <- vtyConfigPath
|
|
||||||
|
|
||||||
result <- E.try $ addConfigWidthMap configPath tName outputPath
|
result <- E.try $ addConfigWidthMap (configPath config) tName outputPath
|
||||||
|
|
||||||
putStrLn ""
|
putStrLn ""
|
||||||
case result of
|
case result of
|
||||||
Left (e::E.SomeException) -> do
|
Left (e::E.SomeException) -> do
|
||||||
putStrLn $ "Error updating Vty configuration at " <> configPath <> ": " <> show e
|
putStrLn $ "Error updating Vty configuration at " <> (configPath config) <> ": " <> show e
|
||||||
exitFailure
|
exitFailure
|
||||||
Right ConfigurationCreated -> do
|
Right ConfigurationCreated -> do
|
||||||
putStrLn $ "Configuration file created: " <> configPath
|
putStrLn $ "Configuration file created: " <> (configPath config)
|
||||||
Right ConfigurationModified -> do
|
Right ConfigurationModified -> do
|
||||||
putStrLn $ "Configuration file updated: " <> configPath
|
putStrLn $ "Configuration file updated: " <> (configPath config)
|
||||||
Right (ConfigurationConflict other) -> do
|
Right (ConfigurationConflict other) -> do
|
||||||
putStrLn $ "Configuration file not updated: uses a different map for terminal type " <> tName <> ": " <> other
|
putStrLn $ "Configuration file not updated: uses a different map for terminal type " <> tName <> ": " <> other
|
||||||
Right ConfigurationRedundant -> do
|
Right ConfigurationRedundant -> do
|
||||||
putStrLn $ "Configuration file not updated: configuration already contains map " <> outputPath <> " for TERM=" <> tName
|
putStrLn $ "Configuration file not updated: configuration " <> (configPath config) <> " already contains map " <> outputPath <> " for TERM=" <> tName
|
||||||
|
Loading…
Reference in New Issue
Block a user