UnicodeWidthTable.Query: make bound configurable, make command-line tool customize it

src/Graphics/Vty/UnicodeWidthTable/Query.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE TupleSections #-}
 module Graphics.Vty.UnicodeWidthTable.Query
   ( buildUnicodeWidthTable
+  , defaultUnicodeTableUpperBound
   )
 where
 
@@ -53,8 +54,8 @@ mkRanges pairs =
 
 -- The uppermost code point to consider when building Unicode width
 -- tables.
-unicodeTableUpperBound :: Char
-unicodeTableUpperBound = '\xe0000'
+defaultUnicodeTableUpperBound :: Char
+defaultUnicodeTableUpperBound = '\xe0000'
 
 -- | Construct a unicode character width table by querying the terminal
 -- connected to stdout. This works by emitting characters to stdout
@@ -65,9 +66,9 @@ unicodeTableUpperBound = '\xe0000'
 -- controlled by Vty.
 --
 -- This does not handle exceptions.
-buildUnicodeWidthTable :: IO UnicodeWidthTable
-buildUnicodeWidthTable = do
-    pairs <- forM (filter shouldConsider ['\0'..unicodeTableUpperBound]) $ \i ->
+buildUnicodeWidthTable :: Char -> IO UnicodeWidthTable
+buildUnicodeWidthTable tableUpperBound = do
+    pairs <- forM (filter shouldConsider ['\0'..tableUpperBound]) $ \i ->
         (i,) <$> charWidth i
 
     return UnicodeWidthTable { unicodeWidthTableRanges = reverse $ mkRanges pairs

tools/BuildWidthTable.hs

@@ -9,6 +9,7 @@ import Data.Semigroup ((<>))
 import System.Environment (getArgs, getProgName)
 import System.Exit (exitFailure)
 import System.Console.GetOpt
+import Text.Read (readMaybe)
 
 import Graphics.Vty.Config (terminalWidthTablePath, currentTerminalName, vtyConfigPath)
 import Graphics.Vty.UnicodeWidthTable.IO
@@ -16,12 +17,16 @@ import Graphics.Vty.UnicodeWidthTable.Query
 
 data Arg = Help
          | OutputPath String
+         | TableUpperBound String
          deriving (Eq, Show)
 
 options :: Config -> [OptDescr Arg]
 options config =
     [ Option "h" ["help"] (NoArg Help)
       "This help output"
+    , Option "b" ["bound"] (ReqArg TableUpperBound "MAX_CHAR")
+      ("The maximum Unicode code point to test when building the table " <>
+       "(default: " <> (show $ fromEnum $ configBound config) <> ")")
     , Option "p" ["path"] (ReqArg OutputPath "PATH")
       ("The output path to write to (default: " <>
        fromMaybe "<none>" (configOutputPath config) <> ")")
@@ -29,12 +34,14 @@ options config =
 
 data Config =
     Config { configOutputPath :: Maybe FilePath
+           , configBound :: Char
            }
            deriving (Show)
 
 mkDefaultConfig :: IO Config
 mkDefaultConfig = do
     Config <$> terminalWidthTablePath
+           <*> pure defaultUnicodeTableUpperBound
 
 usage :: IO ()
 usage = do
@@ -53,6 +60,10 @@ usage = do
 updateConfigFromArg :: Arg -> Config -> Config
 updateConfigFromArg Help c =
     c
+updateConfigFromArg (TableUpperBound s) c =
+    case readMaybe s of
+        Nothing -> error $ "Invalid table upper bound: " <> show s
+        Just v  -> c { configBound = toEnum v }
 updateConfigFromArg (OutputPath p) c =
     c { configOutputPath = Just p }
 
@@ -79,7 +90,7 @@ main = do
         Just path -> return path
 
     putStrLn "Querying terminal:"
-    builtTable <- buildUnicodeWidthTable
+    builtTable <- buildUnicodeWidthTable $ configBound config
     writeUnicodeWidthTable outputPath builtTable
     putStrLn $ "\nOutput table written to " <> outputPath