@@ -1,31 +1,82 @@
11module Main where
22
3+import Control.Monad (when)
4+import Data.Maybe (fromMaybe)
5+import System.Environment (getArgs, getProgName)
36import System.Exit (exitFailure)
7+import System.Console.GetOpt
48
9+import Graphics.Vty.Config (terminalWidthTablePath)
510import Graphics.Vty.UnicodeWidthTable.Types
611import Graphics.Vty.UnicodeWidthTable.IO
712import Graphics.Vty.UnicodeWidthTable.Query
813
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+
957main :: IO ()
1058main = do
11− let r1 = WidthTableRange 0 100 1
12− r2 = WidthTableRange 101 200 2
13− t = UnicodeWidthTable { unicodeWidthTableRanges = [r1, r2]
14− }
59+ defConfig <- mkDefaultConfig
60+ strArgs <- getArgs
61+ let (args, unused, errors) = getOpt Permute (options defConfig) strArgs
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
1570
16− writeUnicodeWidthTable "testfile.dat" t
17− result <- readUnicodeWidthTable "testfile.dat"
71+ let config = configFromArgs args defConfig
1872
19− case result of
20− Left msg -> do
21− putStrLn $ "Error reading table: " <> msg
73+ outputPath <- case configOutputPath config of
74+ Nothing -> do
75+ putStrLn "Error: could not obtain terminal width table path"
2276 exitFailure
23− Right t2 -> do
24− putStrLn "Original table:"
25− print t
26− putStrLn "New table:"
27− print t2
77+ Just path -> return path
2878
79+ putStrLn "Querying terminal:"
2980 builtTable <- buildUnicodeWidthTable
30− print builtTable
31− writeUnicodeWidthTable "terminal_widths.dat" builtTable
81+ writeUnicodeWidthTable outputPath builtTable
82+ putStrLn $ "\nOutput table written to " <> outputPath