git.iko.soy/vty
on master help sign in
vty-build-table: use GetOpt to clean up and improve command line UI
0db1f71Jonathan Daugherty
tools/BuildUnicodeTable.hs+67−16
compare with master
unifiedsplit
@@ -1,31 +1,82 @@
1module Main where
1module Main where
2
2
3+import Control.Monad (when)
4+import Data.Maybe (fromMaybe)
5+import System.Environment (getArgs, getProgName)
3import System.Exit (exitFailure)
6import System.Exit (exitFailure)
7+import System.Console.GetOpt
4
8
9+import Graphics.Vty.Config (terminalWidthTablePath)
5import Graphics.Vty.UnicodeWidthTable.Types
10import Graphics.Vty.UnicodeWidthTable.Types
6import Graphics.Vty.UnicodeWidthTable.IO
11import Graphics.Vty.UnicodeWidthTable.IO
7import Graphics.Vty.UnicodeWidthTable.Query
12import Graphics.Vty.UnicodeWidthTable.Query
8
13
14+data Arg = Help
15+ | OutputPath String
16+ deriving (Eq, Show)
17+
18+options :: Config -> [OptDescr Arg]
19+options config =
20+ [ Option "h" ["help"] (NoArg Help)
21+ "This help output"
22+ , Option "p" ["path"] (ReqArg OutputPath "PATH")
23+ ("The output path to write to (default: " <> fromMaybe "<none>" (configOutputPath config) <> ")")
24+ ]
25+
26+data Config =
27+ Config { configOutputPath :: Maybe FilePath
28+ }
29+ deriving (Show)
30+
31+mkDefaultConfig :: IO Config
32+mkDefaultConfig = do
33+ Config <$> terminalWidthTablePath
34+
35+usage :: IO ()
36+usage = do
37+ config <- mkDefaultConfig
38+ pn <- getProgName
39+ putStrLn $ "Usage: " <> pn <> " [options]"
40+ putStrLn ""
41+ putStrLn "This tool queries the terminal on stdout to determine the widths"
42+ putStrLn "of Unicode characters rendered to the terminal. The resulting data"
43+ putStrLn "is written to a table at the specified output path for later"
44+ putStrLn "loading by Vty-based applications."
45+ putStrLn ""
46+
47+ putStrLn $ usageInfo pn (options config)
48+
49+configFromArgs :: [Arg] -> Config -> Config
50+configFromArgs [] c =
51+ c
52+configFromArgs (Help:as) c =
53+ configFromArgs as c
54+configFromArgs (OutputPath p:as) c =
55+ configFromArgs as (c { configOutputPath = Just p })
56+
9main :: IO ()
57main :: IO ()
10main = do
58main = do
11− let r1 = WidthTableRange 0 100 1
59+ defConfig <- mkDefaultConfig
12− r2 = WidthTableRange 101 200 2
60+ strArgs <- getArgs
13− t = UnicodeWidthTable { unicodeWidthTableRanges = [r1, r2]
61+ let (args, unused, errors) = getOpt Permute (options defConfig) strArgs
14− }
62+
63+ when (not $ null errors) $ do
64+ mapM_ putStrLn errors
65+ exitFailure
66+
67+ when ((not $ null unused) || (Help `elem` args)) $ do
68+ usage
69+ exitFailure
15
70
16− writeUnicodeWidthTable "testfile.dat" t
71+ let config = configFromArgs args defConfig
17− result <- readUnicodeWidthTable "testfile.dat"
18
72
19− case result of
73+ outputPath <- case configOutputPath config of
20− Left msg -> do
74+ Nothing -> do
21− putStrLn $ "Error reading table: " <> msg
75+ putStrLn "Error: could not obtain terminal width table path"
22 exitFailure
76 exitFailure
23− Right t2 -> do
77+ Just path -> return path
24− putStrLn "Original table:"
25− print t
26− putStrLn "New table:"
27− print t2
28
78
79+ putStrLn "Querying terminal:"
29 builtTable <- buildUnicodeWidthTable
80 builtTable <- buildUnicodeWidthTable
30− print builtTable
81+ writeUnicodeWidthTable outputPath builtTable
31− writeUnicodeWidthTable "terminal_widths.dat" builtTable
82+ putStrLn $ "\nOutput table written to " <> outputPath