fountainhead/app/Main.hs

module Main
    ( main
    ) where

import Data.Bifunctor (Bifunctor(..))
import qualified Text.Megaparsec as Megaparsec
import qualified Data.Text.Lazy.Builder as Text.Builder
import qualified Data.Text.Lazy.IO as Text.Lazy
import Graphics.Fountainhead (parseFontDirectoryFromFile)
import Graphics.Fountainhead.Dumper (DumpError(..), dumpTables)
-- TODO: kern table since format 1.
-- For details on subtable format see examples in TrueType reference.
import System.Environment (getArgs)
import System.Exit (exitWith)
import GHC.IO.Exception (ExitCode(..))

fontMain :: FilePath -> IO ()
fontMain fontFile = do
    putStrLn ("Dumping File:" <> fontFile <> "\n\n")

    (processedState, initialResult) <- parseFontDirectoryFromFile fontFile

    case first DumpParseError initialResult >>= dumpTables processedState of
        Right fontDump -> Text.Lazy.putStrLn $ Text.Builder.toLazyText fontDump
        Left e
            | DumpParseError bundle <- e -> putStr
                $ Megaparsec.errorBundlePretty bundle
            | DumpRequiredTableMissingError tableName <- e -> putStr
                $ "Required table " <> tableName <> " is missing."

main :: IO ()
main = do
    programArguments <- getArgs
    case programArguments of
        [fontFile] -> fontMain fontFile
        _ -> putStrLn "The program expects exactly one argument, the font file path."
            >> exitWith (ExitFailure 2)