ilyakooo0/vty
1
0
Fork 0
mirror of https://github.com/ilyakooo0/vty.git synced 2024-10-04 03:07:07 +03:00
Code Issues Projects Releases Wiki Activity

BuildWidthTable: add command-line flag to control which configuration file is updated

Browse Source
This commit is contained in:
Jonathan Daugherty 2020-03-06 09:33:57 -08:00
parent c204e6dd21
commit 63746c65e7
1 changed files with 13 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
tools/BuildWidthTable.hs
View File

@ -26,6 +26,7 @@ data Arg = Help
| OutputPath String
| TableUpperBound String
| UpdateConfig
| VtyConfigPath String
deriving (Eq, Show)
options :: Config -> [OptDescr Arg]
@ -40,12 +41,16 @@ options config =
fromMaybe "<none>" (configOutputPath config) <> ")")
, Option "u" ["update-config"] (NoArg UpdateConfig)
"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 =
Config { configOutputPath :: Maybe FilePath
, configBound :: Char
, configUpdate :: Bool
, configPath :: FilePath
}
deriving (Show)
@ -54,6 +59,7 @@ mkDefaultConfig = do
Config <$> terminalWidthTablePath
<*> pure defaultUnicodeTableUpperBound
<*> pure False
<*> vtyConfigPath
usage :: IO ()
usage = do
@ -74,6 +80,8 @@ updateConfigFromArg Help c =
c
updateConfigFromArg UpdateConfig c =
c { configUpdate = True }
updateConfigFromArg (VtyConfigPath p) c =
c { configPath = p }
updateConfigFromArg (TableUpperBound s) c =
case readMaybe s of
Nothing -> error $ "Invalid table upper bound: " <> show s
@ -113,20 +121,19 @@ main = do
when (configUpdate config) $ do
Just tName <- currentTerminalName
configPath <- vtyConfigPath
result <- E.try $ addConfigWidthMap configPath tName outputPath
result <- E.try $ addConfigWidthMap (configPath config) tName outputPath
putStrLn ""
case result of
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
Right ConfigurationCreated -> do
putStrLn $ "Configuration file created: " <> configPath
putStrLn $ "Configuration file created: " <> (configPath config)
Right ConfigurationModified -> do
putStrLn $ "Configuration file updated: " <> configPath
putStrLn $ "Configuration file updated: " <> (configPath config)
Right (ConfigurationConflict other) -> do
putStrLn $ "Configuration file not updated: uses a different map for terminal type " <> tName <> ": " <> other
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