Extract some convenience parsing functions

1 files changed, 9 insertions, 22 deletions

diff --git a/lib/Graphics/Fountainhead.hs b/lib/Graphics/Fountainhead.hs
index 8e36517..fd46777 100644
--- a/lib/Graphics/Fountainhead.hs
+++ b/lib/Graphics/Fountainhead.hs
@@ -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