fountainhead/app/Main.hs

38 lines
1.4 KiB
Haskell
Raw Normal View History

2023-03-14 09:52:02 +01:00
module Main
( main
) where
2023-12-27 16:19:21 +01:00
import Data.Bifunctor (Bifunctor(..))
2023-03-14 09:52:02 +01:00
import qualified Text.Megaparsec as Megaparsec
2023-11-10 16:45:45 +01:00
import qualified Data.Text.Lazy.Builder as Text.Builder
import qualified Data.Text.Lazy.IO as Text.Lazy
2023-12-27 16:19:21 +01:00
import Graphics.Fountainhead (parseFontDirectoryFromFile)
import Graphics.Fountainhead.Dumper (DumpError(..), dumpTables)
2023-03-14 09:52:02 +01:00
-- TODO: kern table since format 1.
-- For details on subtable format see examples in TrueType reference.
import System.Environment (getArgs)
2023-11-10 11:57:08 +01:00
import System.Exit (exitWith)
import GHC.IO.Exception (ExitCode(..))
2023-03-14 09:52:02 +01:00
2023-11-10 11:57:08 +01:00
fontMain :: FilePath -> IO ()
fontMain fontFile = do
2023-12-27 16:19:21 +01:00
putStrLn ("Dumping File:" <> fontFile <> "\n\n")
2023-11-10 16:45:45 +01:00
2023-12-27 16:19:21 +01:00
(processedState, initialResult) <- parseFontDirectoryFromFile fontFile
case first DumpParseError initialResult >>= dumpTables processedState of
2023-11-18 04:40:17 +01:00
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."
2023-11-10 16:45:45 +01:00
2023-03-14 09:52:02 +01:00
main :: IO ()
2023-11-10 11:57:08 +01:00
main = do
programArguments <- getArgs
case programArguments of
[fontFile] -> fontMain fontFile
_ -> putStrLn "The program expects exactly one argument, the font file path."
>> exitWith (ExitFailure 2)