Extract some convenience parsing functions

This commit is contained in:
2024-02-07 10:40:00 +01:00
parent 23271d6f6c
commit c5f715ac7c
9 changed files with 139 additions and 64 deletions

View File

@@ -11,37 +11,24 @@ module Graphics.Fountainhead
import Data.ByteString (ByteString)
import Data.Void (Void)
import Graphics.Fountainhead.Dumper (dumpTable, dumpTables, DumpError(..))
import Graphics.Fountainhead.Parser (ParseErrorBundle, fontDirectoryP)
import Graphics.Fountainhead.Parser (ParseErrorBundle, parseFontDirectory)
import Graphics.Fountainhead.TrueType (FontDirectory(..))
import qualified Text.Megaparsec as Megaparsec
import Text.Megaparsec (PosState(..), State(..))
import Text.Megaparsec (State(..))
import System.IO (IOMode(..), withBinaryFile)
import Data.Bifunctor (Bifunctor(..))
import qualified Data.Text.Lazy.Builder as Text.Builder
import Graphics.Fountainhead.Compression (hDecompress)
-- | Does initial parsing of the font at the given path and returns the font
-- directory and parsing state that can be used to parse other tables in the
-- font.
parseFontDirectoryFromFile :: FilePath
-> IO (State ByteString Void, Either ParseErrorBundle FontDirectory)
parseFontDirectoryFromFile fontFile =
withBinaryFile fontFile ReadMode withFontHandle
where
withFontHandle fontHandle = doParsing
<$> hDecompress fontHandle
doParsing ttfContents =
let initialState = Megaparsec.State
{ stateInput = ttfContents
, stateOffset = 0
, statePosState = Megaparsec.PosState
{ pstateInput = ttfContents
, pstateOffset = 0
, pstateSourcePos = Megaparsec.initialPos fontFile
, pstateTabWidth = Megaparsec.defaultTabWidth
, pstateLinePrefix = ""
}
, stateParseErrors = []
}
in Megaparsec.runParser' fontDirectoryP initialState
parseFontDirectoryFromFile fontFile = withBinaryFile fontFile ReadMode
$ fmap (parseFontDirectory fontFile) . hDecompress
-- | Dumps the contents of the font in the file. If the table name is given,
-- dumps only this one table.
dumpFontFile :: FilePath -> Maybe String -> IO (Either DumpError Text.Builder.Builder)
dumpFontFile fontFile tableName = do
let dumpRequest = maybe dumpTables dumpTable tableName