fountainhead/lib/Graphics/Fountainhead.hs

37 lines
1.7 KiB
Haskell

{- This Source Code Form is subject to the terms of the Mozilla Public License,
v. 2.0. If a copy of the MPL was not distributed with this file, You can
obtain one at https://mozilla.org/MPL/2.0/. -}
-- | Convenience wrappers for working with font files.
module Graphics.Fountainhead
( dumpFontFile
, parseFontDirectoryFromFile
) where
import Data.ByteString (ByteString)
import Data.Void (Void)
import Graphics.Fountainhead.Dumper (dumpTable, dumpTables, DumpError(..))
import Graphics.Fountainhead.Parser (ParseErrorBundle, parseFontDirectory)
import Graphics.Fountainhead.TrueType (FontDirectory(..))
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
$ 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
(processedState, initialResult) <- parseFontDirectoryFromFile fontFile
pure $ first DumpParseError initialResult >>= dumpRequest processedState