content: {-# LANGUAGE CPP #-}
  module Graphics.Vty.UnicodeWidthTable.IO
    ( readUnicodeWidthTable
    , parseUnicodeWidthTable
    , writeUnicodeWidthTable
    )
  where
  
  import Control.Monad (when, forM)
  import Data.Binary
  import Data.Binary.Get
  import Data.Binary.Put
  import qualified Data.ByteString.Lazy as BSL
  #if !(MIN_VERSION_base(4,11,0))
  import Data.Semigroup ((<>))
  #endif
  
  import Graphics.Vty.UnicodeWidthTable.Types
  
  -- | Load a binary unicode width table from the specified file.
  --
  -- This either returns a successfully parsed table or a table parsing
  -- error message. This does not handle I/O exceptions.
  readUnicodeWidthTable :: FilePath -> IO (Either String UnicodeWidthTable)
  readUnicodeWidthTable path = parseUnicodeWidthTable <$> BSL.readFile path
  
  -- | Parse a binary unicode width table.
  parseUnicodeWidthTable :: BSL.ByteString -> Either String UnicodeWidthTable
  parseUnicodeWidthTable bs =
      case runGetOrFail tableParser bs of
          Left (_, _, msg) ->
              Left msg
  
          -- Even if we parsed a table, leftover bytes indicate something
          -- could be wrong.
          Right (remainingBytes, _, _) | not (BSL.null remainingBytes) ->
              Left $ "Error: " <> show (BSL.length remainingBytes) <>
                     " byte(s) left unconsumed"
  
          Right (_, _, table) ->
              Right table
  
  -- | Write the unicode width table to the specified path.
  --
  -- This does not handle I/O exceptions.
  writeUnicodeWidthTable :: FilePath -> UnicodeWidthTable -> IO ()
  writeUnicodeWidthTable path table = do
      let body = runPut (tableV1Writer table)
      BSL.writeFile path body
  
  -- | Width table magic bytes for use in the binary format.
  widthTableMagic :: Word32
  widthTableMagic = 0xc1a9f7e0
  
  tableParser :: Get UnicodeWidthTable
  tableParser = do
      magic <- getWord32le
  
      when (magic /= widthTableMagic) $
          fail "Table magic number invalid"
  
      version <- getWord8
  
      case version of
          1 -> tableV1Parser
          _ -> fail "Table version invalid"
  
  tableV1Parser :: Get UnicodeWidthTable
  tableV1Parser = do
      numRanges <- getWord32le
  
      let parseRange = do
              start <- getWord32le
              size <- getWord32le
              cols <- getWord8
              return WidthTableRange { rangeStart = start
                                     , rangeSize = size
                                     , rangeColumns = cols
                                     }
  
      ranges <- forM [1..numRanges] $ const parseRange
  
      return UnicodeWidthTable { unicodeWidthTableRanges = ranges
                               }
  
  tableV1Writer :: UnicodeWidthTable -> Put
  tableV1Writer table = do
      -- Magic bytes
      putWord32le widthTableMagic
  
      -- Version
      putWord8 1
  
      -- Number of ranges
      let ranges = unicodeWidthTableRanges table
      let numRanges = length ranges
      putWord32le (fromIntegral numRanges)
  
      -- Ranges
      let putRange r = do
              putWord32le $ rangeStart r
              putWord32le $ rangeSize r
              putWord8 $ rangeColumns r
  
      mapM_ putRange ranges
  