summaryrefslogtreecommitdiff
path: root/app/Main.hs
blob: afdee16b8162a135d268d79a03d7b65c0b8d22da (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
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)