content: {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE CPP #-}
  -- | This module provides a command-line tool implementation for
  -- building Vty character width tables and updating the user's local Vty
  -- configuration to load them.
  --
  -- The API is parameterized on a platform-specific function to obtain
  -- character widths. For example, on Unix platforms, this could be done
  -- with a routine that communicates with the terminal to query it for
  -- character widths. On other platforms, such a routine might interact
  -- with a system library.
  --
  -- This tool is provided as a library implementation so that the tool
  -- has a consistent interface across platforms and so that it implements
  -- the Vty configuration update the same way everywhere.
  module Graphics.Vty.UnicodeWidthTable.Main
    ( defaultMain
    )
  where
  
  import qualified Control.Exception as E
  import Control.Monad (when)
  import Data.Maybe (fromMaybe)
  #if !(MIN_VERSION_base(4,11,0))
  import Data.Semigroup ((<>))
  #endif
  import System.Directory (createDirectoryIfMissing)
  import System.Environment (getArgs, getProgName)
  import System.FilePath (takeDirectory)
  import System.Exit (exitFailure)
  import System.Console.GetOpt
  import Text.Read (readMaybe)
  
  import Graphics.Vty.Config ( terminalWidthTablePath, currentTerminalName
                             , vtyConfigPath, addConfigWidthMap
                             , ConfigUpdateResult(..)
                             )
  import Graphics.Vty.UnicodeWidthTable.IO
  import Graphics.Vty.UnicodeWidthTable.Query
  
  data Arg = Help
           | OutputPath String
           | TableUpperBound String
           | UpdateConfig
           | VtyConfigPath 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) <> ")")
      , Option "u" ["update-config"] (NoArg UpdateConfig)
        "Create or update the Vty configuration file to use the new table (default: no)"
      , Option "c" ["config-path"] (ReqArg VtyConfigPath "PATH")
        ("Update the specified Vty configuration file path when -u is set (default: " <>
         configPath config <> ")")
      ]
  
  data Config =
      Config { configOutputPath :: Maybe FilePath
             , configBound :: Char
             , configUpdate :: Bool
             , configPath :: FilePath
             }
             deriving (Show)
  
  mkDefaultConfig :: IO Config
  mkDefaultConfig = do
      Config <$> terminalWidthTablePath
             <*> pure defaultUnicodeTableUpperBound
             <*> pure False
             <*> vtyConfigPath
  
  usage :: IO ()
  usage = do
      config <- mkDefaultConfig
      pn <- getProgName
      putStrLn $ "Usage: " <> pn <> " [options]"
      putStrLn ""
      putStrLn "This tool queries the terminal on stdout to determine the widths"
      putStrLn "of Unicode characters rendered to the terminal. The resulting data"
      putStrLn "is written to a table at the specified output path for later"
      putStrLn "loading by Vty-based applications."
      putStrLn ""
  
      putStrLn $ usageInfo pn (options config)
  
  updateConfigFromArg :: Arg -> Config -> Config
  updateConfigFromArg Help c =
      c
  updateConfigFromArg UpdateConfig c =
      c { configUpdate = True }
  updateConfigFromArg (VtyConfigPath p) c =
      c { configPath = p }
  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 }
  
  -- | Run the character width table builder tool using the specified
  -- function to obtain character widths. This is intended to be a 'main'
  -- implementation, e.g. @main = defaultMain getCharWidth@.
  --
  -- The tool queries the local terminal in some way (as determined by
  -- the provided function) over a wide range of Unicode code points and
  -- generates a table of character widths that can subsequently be loaded
  -- by Vty-based applications.
  --
  -- The tool respects the following command-line flags, all of which are
  -- optional and have sensible defaults:
  --
  -- * @-h@/@--help@: help output
  -- * @-b@/@--bound@: Unicode code point upper bound to use when building
  --   the table.
  -- * @-p@/@--path@: the output path where the generated table should be
  --   written.
  -- * @-u@/@--update-config@: If given, create or update the user's Vty
  --   configuration file to use the new table.
  -- * @-c@/@--config-path@: the path to the user's Vty configuration.
  defaultMain :: (Char -> IO Int) -> IO ()
  defaultMain charWidth = do
      defConfig <- mkDefaultConfig
      strArgs <- getArgs
      let (args, unused, errors) = getOpt Permute (options defConfig) strArgs
  
      when (not $ null errors) $ do
          mapM_ putStrLn errors
          exitFailure
  
      when ((not $ null unused) || (Help `elem` args)) $ do
          usage
          exitFailure
  
      let config = foldr updateConfigFromArg defConfig args
  
      outputPath <- case configOutputPath config of
          Nothing -> do
              putStrLn "Error: could not obtain terminal width table path"
              exitFailure
          Just path -> return path
  
      putStrLn "Querying terminal:"
      builtTable <- buildUnicodeWidthTable charWidth $ configBound config
  
      let dir = takeDirectory outputPath
      createDirectoryIfMissing True dir
      writeUnicodeWidthTable outputPath builtTable
  
      putStrLn $ "\nOutput table written to " <> outputPath
  
      when (configUpdate config) $ do
          let cPath = configPath config
          Just tName <- currentTerminalName
  
          result <- E.try $ addConfigWidthMap cPath tName outputPath
  
          case result of
              Left (e::E.SomeException) -> do
                  putStrLn $ "Error updating Vty configuration at " <> cPath <> ": " <>
                             show e
                  exitFailure
              Right ConfigurationCreated -> do
                  putStrLn $ "Configuration file created: " <> cPath
              Right ConfigurationModified -> do
                  putStrLn $ "Configuration file updated: " <> cPath
              Right (ConfigurationConflict other) -> do
                  putStrLn $ "Configuration file not updated: uses a different table " <>
                             "for TERM=" <> tName <> ": " <> other
              Right ConfigurationRedundant -> do
                  putStrLn $ "Configuration file not updated: configuration " <>
                             cPath <> " already uses table " <> outputPath <>
                             " for TERM=" <> tName
  