on master help sign in
UnicodeWidthTable.Query: make bound configurable, make command-line tool customize it
commiteb1983d22d5cdfb9fe1f44b49b7309144094b436 authorJonathan Daugherty <cygnus@foobox.com> dateThu 5 Mar 2020, 14:45 (7 years ago) parentaebf480
2 files changed+18−6
src/Graphics/Vty/UnicodeWidthTable/Query.hs+6−5 tools/BuildWidthTable.hs+12−1
src/Graphics/Vty/UnicodeWidthTable/Query.hs+6−5
@@ -1,6 +1,7 @@
11{-# LANGUAGE TupleSections #-}
22module Graphics.Vty.UnicodeWidthTable.Query
33 ( buildUnicodeWidthTable
4+ , defaultUnicodeTableUpperBound
45 )
56where
67
@@ -53,8 +54,8 @@ mkRanges pairs =
5354
5455-- The uppermost code point to consider when building Unicode width
5556-- tables.
56−unicodeTableUpperBound :: Char
57−unicodeTableUpperBound = '\xe0000'
57+defaultUnicodeTableUpperBound :: Char
58+defaultUnicodeTableUpperBound = '\xe0000'
5859
5960-- | Construct a unicode character width table by querying the terminal
6061-- connected to stdout. This works by emitting characters to stdout
@@ -65,9 +66,9 @@ unicodeTableUpperBound = '\xe0000'
6566-- controlled by Vty.
6667--
6768-- This does not handle exceptions.
68−buildUnicodeWidthTable :: IO UnicodeWidthTable
69−buildUnicodeWidthTable = do
70− pairs <- forM (filter shouldConsider ['\0'..unicodeTableUpperBound]) $ \i ->
69+buildUnicodeWidthTable :: Char -> IO UnicodeWidthTable
70+buildUnicodeWidthTable tableUpperBound = do
71+ pairs <- forM (filter shouldConsider ['\0'..tableUpperBound]) $ \i ->
7172 (i,) <$> charWidth i
7273
7374 return UnicodeWidthTable { unicodeWidthTableRanges = reverse $ mkRanges pairs
tools/BuildWidthTable.hs+12−1
@@ -9,6 +9,7 @@ import Data.Semigroup ((<>))
99import System.Environment (getArgs, getProgName)
1010import System.Exit (exitFailure)
1111import System.Console.GetOpt
12+import Text.Read (readMaybe)
1213
1314import Graphics.Vty.Config (terminalWidthTablePath, currentTerminalName, vtyConfigPath)
1415import Graphics.Vty.UnicodeWidthTable.IO
@@ -16,12 +17,16 @@ import Graphics.Vty.UnicodeWidthTable.Query
1617
1718data Arg = Help
1819 | OutputPath String
20+ | TableUpperBound String
1921 deriving (Eq, Show)
2022
2123options :: Config -> [OptDescr Arg]
2224options config =
2325 [ Option "h" ["help"] (NoArg Help)
2426 "This help output"
27+ , Option "b" ["bound"] (ReqArg TableUpperBound "MAX_CHAR")
28+ ("The maximum Unicode code point to test when building the table " <>
29+ "(default: " <> (show $ fromEnum $ configBound config) <> ")")
2530 , Option "p" ["path"] (ReqArg OutputPath "PATH")
2631 ("The output path to write to (default: " <>
2732 fromMaybe "<none>" (configOutputPath config) <> ")")
@@ -29,12 +34,14 @@ options config =
2934
3035data Config =
3136 Config { configOutputPath :: Maybe FilePath
37+ , configBound :: Char
3238 }
3339 deriving (Show)
3440
3541mkDefaultConfig :: IO Config
3642mkDefaultConfig = do
3743 Config <$> terminalWidthTablePath
44+ <*> pure defaultUnicodeTableUpperBound
3845
3946usage :: IO ()
4047usage = do
@@ -53,6 +60,10 @@ usage = do
5360updateConfigFromArg :: Arg -> Config -> Config
5461updateConfigFromArg Help c =
5562 c
63+updateConfigFromArg (TableUpperBound s) c =
64+ case readMaybe s of
65+ Nothing -> error $ "Invalid table upper bound: " <> show s
66+ Just v -> c { configBound = toEnum v }
5667updateConfigFromArg (OutputPath p) c =
5768 c { configOutputPath = Just p }
5869
@@ -79,7 +90,7 @@ main = do
7990 Just path -> return path
8091
8192 putStrLn "Querying terminal:"
82− builtTable <- buildUnicodeWidthTable
93+ builtTable <- buildUnicodeWidthTable $ configBound config
8394 writeUnicodeWidthTable outputPath builtTable
8495 putStrLn $ "\nOutput table written to " <> outputPath
8596