git.iko.soy/vty
on master help sign in
UnicodeWidthTable.Query: make bound configurable, make command-line tool customize it
eb1983dJonathan Daugherty
src/Graphics/Vty/UnicodeWidthTable/Query.hs+6−5
compare with master
unifiedsplit
@@ -1,6 +1,7 @@
1{-# LANGUAGE TupleSections #-}
1{-# LANGUAGE TupleSections #-}
2module Graphics.Vty.UnicodeWidthTable.Query
2module Graphics.Vty.UnicodeWidthTable.Query
3 ( buildUnicodeWidthTable
3 ( buildUnicodeWidthTable
4+ , defaultUnicodeTableUpperBound
4 )
5 )
5where
6where
6
7
@@ -53,8 +54,8 @@ mkRanges pairs =
53
54
54-- The uppermost code point to consider when building Unicode width
55-- The uppermost code point to consider when building Unicode width
55-- tables.
56-- tables.
56−unicodeTableUpperBound :: Char
57+defaultUnicodeTableUpperBound :: Char
57−unicodeTableUpperBound = '\xe0000'
58+defaultUnicodeTableUpperBound = '\xe0000'
58
59
59-- | Construct a unicode character width table by querying the terminal
60-- | Construct a unicode character width table by querying the terminal
60-- connected to stdout. This works by emitting characters to stdout
61-- connected to stdout. This works by emitting characters to stdout
@@ -65,9 +66,9 @@ unicodeTableUpperBound = '\xe0000'
65-- controlled by Vty.
66-- controlled by Vty.
66--
67--
67-- This does not handle exceptions.
68-- This does not handle exceptions.
68−buildUnicodeWidthTable :: IO UnicodeWidthTable
69+buildUnicodeWidthTable :: Char -> IO UnicodeWidthTable
69−buildUnicodeWidthTable = do
70+buildUnicodeWidthTable tableUpperBound = do
70− pairs <- forM (filter shouldConsider ['\0'..unicodeTableUpperBound]) $ \i ->
71+ pairs <- forM (filter shouldConsider ['\0'..tableUpperBound]) $ \i ->
71 (i,) <$> charWidth i
72 (i,) <$> charWidth i
72
73
73 return UnicodeWidthTable { unicodeWidthTableRanges = reverse $ mkRanges pairs
74 return UnicodeWidthTable { unicodeWidthTableRanges = reverse $ mkRanges pairs
tools/BuildWidthTable.hs+12−1
@@ -9,6 +9,7 @@ import Data.Semigroup ((<>))
9import System.Environment (getArgs, getProgName)
9import System.Environment (getArgs, getProgName)
10import System.Exit (exitFailure)
10import System.Exit (exitFailure)
11import System.Console.GetOpt
11import System.Console.GetOpt
12+import Text.Read (readMaybe)
12
13
13import Graphics.Vty.Config (terminalWidthTablePath, currentTerminalName, vtyConfigPath)
14import Graphics.Vty.Config (terminalWidthTablePath, currentTerminalName, vtyConfigPath)
14import Graphics.Vty.UnicodeWidthTable.IO
15import Graphics.Vty.UnicodeWidthTable.IO
@@ -16,12 +17,16 @@ import Graphics.Vty.UnicodeWidthTable.Query
16
17
17data Arg = Help
18data Arg = Help
18 | OutputPath String
19 | OutputPath String
20+ | TableUpperBound String
19 deriving (Eq, Show)
21 deriving (Eq, Show)
20
22
21options :: Config -> [OptDescr Arg]
23options :: Config -> [OptDescr Arg]
22options config =
24options config =
23 [ Option "h" ["help"] (NoArg Help)
25 [ Option "h" ["help"] (NoArg Help)
24 "This help output"
26 "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) <> ")")
25 , Option "p" ["path"] (ReqArg OutputPath "PATH")
30 , Option "p" ["path"] (ReqArg OutputPath "PATH")
26 ("The output path to write to (default: " <>
31 ("The output path to write to (default: " <>
27 fromMaybe "<none>" (configOutputPath config) <> ")")
32 fromMaybe "<none>" (configOutputPath config) <> ")")
@@ -29,12 +34,14 @@ options config =
29
34
30data Config =
35data Config =
31 Config { configOutputPath :: Maybe FilePath
36 Config { configOutputPath :: Maybe FilePath
37+ , configBound :: Char
32 }
38 }
33 deriving (Show)
39 deriving (Show)
34
40
35mkDefaultConfig :: IO Config
41mkDefaultConfig :: IO Config
36mkDefaultConfig = do
42mkDefaultConfig = do
37 Config <$> terminalWidthTablePath
43 Config <$> terminalWidthTablePath
44+ <*> pure defaultUnicodeTableUpperBound
38
45
39usage :: IO ()
46usage :: IO ()
40usage = do
47usage = do
@@ -53,6 +60,10 @@ usage = do
53updateConfigFromArg :: Arg -> Config -> Config
60updateConfigFromArg :: Arg -> Config -> Config
54updateConfigFromArg Help c =
61updateConfigFromArg Help c =
55 c
62 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 }
56updateConfigFromArg (OutputPath p) c =
67updateConfigFromArg (OutputPath p) c =
57 c { configOutputPath = Just p }
68 c { configOutputPath = Just p }
58
69
@@ -79,7 +90,7 @@ main = do
79 Just path -> return path
90 Just path -> return path
80
91
81 putStrLn "Querying terminal:"
92 putStrLn "Querying terminal:"
82− builtTable <- buildUnicodeWidthTable
93+ builtTable <- buildUnicodeWidthTable $ configBound config
83 writeUnicodeWidthTable outputPath builtTable
94 writeUnicodeWidthTable outputPath builtTable
84 putStrLn $ "\nOutput table written to " <> outputPath
95 putStrLn $ "\nOutput table written to " <> outputPath
85
96