@@ -0,0 +1,117 @@
1+module Graphics.Vty.UnicodeWidthTable.IO
2+ ( readUnicodeWidthTable
3+ , writeUnicodeWidthTable
7+import Control.Monad (when, forM)
10+import Data.Binary.Put
11+import qualified Data.ByteString.Lazy as BSL
13+import Graphics.Vty.UnicodeWidthTable.Types
15+-- | Load a binary unicode width table from the specified file.
17+-- This either returns a successfully parsed table or a table parsing
18+-- error message. This does not handle I/O exceptions.
19+readUnicodeWidthTable :: FilePath -> IO (Either String UnicodeWidthTable)
20+readUnicodeWidthTable path = do
21+ body <- BSL.readFile path
22+ case runGetOrFail tableParser body of
26+ -- Even if we parsed a table, leftover bytes indicate something
28+ Right (remainingBytes, _, _) | not (BSL.null remainingBytes) ->
29+ return $ Left $ "Error: " <> show (BSL.length remainingBytes) <>
30+ " byte(s) left unconsumed"
32+ Right (_, _, table) ->
35+-- | Write the unicode width table to the specified path.
37+-- This does not handle I/O exceptions.
38+writeUnicodeWidthTable :: FilePath -> UnicodeWidthTable -> IO ()
39+writeUnicodeWidthTable path table = do
40+ let body = runPut (tableV1Writer table)
41+ BSL.writeFile path body
43+-- | Width table magic bytes for use in the binary format.
44+widthTableMagic :: Word32
45+widthTableMagic = 0xc1a9f7e0
47+-- NB: This parsing code uses explicit types for parsing each value to
48+-- catch situations where someone changes the types of the fields of
49+-- WidthTableRange or other values and in doing so would silently break
50+-- the parser. If the parser used a style like
52+-- WidthTableRange <$> get <*> get <*> get
54+-- then that would result in valid Haskell code that would fail to read
55+-- files that it would have previously parsed. We want those errors
56+-- caught by GHc. At the time of this writing, the library data types
57+-- *happen* to match the binary layout of the version 1 format, but that
58+-- could definitely change in later formats. In those cases we should
59+-- deal with the difference by doing the appropriate conversions.
61+tableParser :: Get UnicodeWidthTable
66+ when (magic /= widthTableMagic) $
67+ fail "Table magic number invalid"
74+ _ -> fail "Table version invalid"
76+tableV1Parser :: Get UnicodeWidthTable
88+ return WidthTableRange { rangeStart = start
90+ , rangeColumns = cols
93+ ranges <- forM [1..numRanges] $ const parseRange
95+ return UnicodeWidthTable { unicodeWidthTableRanges = ranges
98+tableV1Writer :: UnicodeWidthTable -> Put
99+tableV1Writer table = do
101+ putWord32le widthTableMagic
107+ let ranges = unicodeWidthTableRanges table
108+ let numRanges = length ranges
109+ putWord32le (fromIntegral numRanges)
113+ putWord32le $ rangeStart r
114+ putWord32le $ rangeSize r
115+ putWord8 $ rangeColumns r
117+ mapM_ putRange ranges