@@ -1,6 +1,8 @@
1+{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE CPP #-}
23module Main where
34
5+import qualified Control.Exception as E
46import Control.Monad (when)
57import Data.Maybe (fromMaybe)
68#if !(MIN_VERSION_base(4,11,0))
@@ -13,13 +15,17 @@ import System.Exit (exitFailure)
1315import System.Console.GetOpt
1416import Text.Read (readMaybe)
1517
16−import Graphics.Vty.Config (terminalWidthTablePath, currentTerminalName, vtyConfigPath)
18+import Graphics.Vty.Config ( terminalWidthTablePath, currentTerminalName
19+ , vtyConfigPath, addConfigWidthMap
20+ , ConfigUpdateResult(..)
21+ )
1722import Graphics.Vty.UnicodeWidthTable.IO
1823import Graphics.Vty.UnicodeWidthTable.Query
1924
2025data Arg = Help
2126 | OutputPath String
2227 | TableUpperBound String
28+ | UpdateConfig
2329 deriving (Eq, Show)
2430
2531options :: Config -> [OptDescr Arg]
@@ -32,11 +38,14 @@ options config =
3238 , Option "p" ["path"] (ReqArg OutputPath "PATH")
3339 ("The output path to write to (default: " <>
3440 fromMaybe "<none>" (configOutputPath config) <> ")")
41+ , Option "u" ["update-config"] (NoArg UpdateConfig)
42+ "Create or update the Vty configuration file to use the new map (default: no)"
3543 ]
3644
3745data Config =
3846 Config { configOutputPath :: Maybe FilePath
3947 , configBound :: Char
48+ , configUpdate :: Bool
4049 }
4150 deriving (Show)
4251
@@ -44,6 +53,7 @@ mkDefaultConfig :: IO Config
4453mkDefaultConfig = do
4554 Config <$> terminalWidthTablePath
4655 <*> pure defaultUnicodeTableUpperBound
56+ <*> pure False
4757
4858usage :: IO ()
4959usage = do
@@ -62,6 +72,8 @@ usage = do
6272updateConfigFromArg :: Arg -> Config -> Config
6373updateConfigFromArg Help c =
6474 c
75+updateConfigFromArg UpdateConfig c =
76+ c { configUpdate = True }
6577updateConfigFromArg (TableUpperBound s) c =
6678 case readMaybe s of
6779 Nothing -> error $ "Invalid table upper bound: " <> show s
@@ -99,11 +111,22 @@ main = do
99111 writeUnicodeWidthTable outputPath builtTable
100112 putStrLn $ "\nOutput table written to " <> outputPath
101113
102− Just tName <- currentTerminalName
103− configPath <- vtyConfigPath
104− putStrLn ""
105− putStrLn "To configure your Vty-based applications to use this map, add"
106− putStrLn $ "the following line to " <> configPath <> ":"
107− putStrLn ""
108− putStrLn $ " widthMap " <> show tName <> " " <> show outputPath
109− putStrLn ""
114+ when (configUpdate config) $ do
115+ Just tName <- currentTerminalName
116+ configPath <- vtyConfigPath
117+
118+ result <- E.try $ addConfigWidthMap configPath tName outputPath
119+
120+ putStrLn ""
121+ case result of
122+ Left (e::E.SomeException) -> do
123+ putStrLn $ "Error updating Vty configuration at " <> configPath <> ": " <> show e
124+ exitFailure
125+ Right ConfigurationCreated -> do
126+ putStrLn $ "Configuration file created: " <> configPath
127+ Right ConfigurationModified -> do
128+ putStrLn $ "Configuration file updated: " <> configPath
129+ Right (ConfigurationConflict other) -> do
130+ putStrLn $ "Configuration file not updated: uses a different map for terminal type " <> tName <> ": " <> other
131+ Right ConfigurationRedundant -> do
132+ putStrLn $ "Configuration file not updated: configuration already contains map " <> outputPath <> " for TERM=" <> tName