Add an option for dumping a single table

lib/Graphics/Fountainhead/Dumper.hs

@@ -14,6 +14,7 @@
 module Graphics.Fountainhead.Dumper
     ( DumpError(..)
     , dumpCmap
+    , dumpGASP
     , dumpGlyf
     , dumpHead
     , dumpHmtx
@@ -23,6 +24,7 @@ module Graphics.Fountainhead.Dumper
     , dumpMaxp
     , dumpOs2
     , dumpPost
+    , dumpTable
     , dumpTables
     , dumpTrueType
     , dumpOffsetTable
@@ -95,7 +97,9 @@ import Graphics.Fountainhead.TrueType
     )
 import qualified Text.Megaparsec as Megaparsec
 import Graphics.Fountainhead.Parser
-    ( fontDirectoryP
+    ( ParseErrorBundle
+    , ParseState
+    , fontDirectoryP
     , parseTable
     , cmapTableP
     , headTableP
@@ -128,6 +132,7 @@ import Prelude hiding (repeat)
 data DumpError
     = DumpParseError (Megaparsec.ParseErrorBundle ByteString Void)
     | DumpRequiredTableMissingError String
+    | DumpRequestedTableMissingError String
     deriving Eq
 
 instance Show DumpError
@@ -135,6 +140,8 @@ instance Show DumpError
     show (DumpParseError errorBundle) = Megaparsec.errorBundlePretty errorBundle
     show (DumpRequiredTableMissingError tableName) =
         "Required table " <> tableName <> " is missing."
+    show (DumpRequestedTableMissingError tableName) =
+        "Requested table " <> tableName <> " is missing."
 
 data RequiredTables = RequiredTables
     { hheaTable :: HheaTable
@@ -785,53 +792,78 @@ dumpGlyf (GlyfTable glyfDescriptions) = dumpCaption "'glyf' Table - Glyf data"
         = "(" <> justifyNumber 7 coordinateX <> ", "
         <> justifyNumber 7 coordinateY <> ")"
 
+dumpTable
+    :: String
+    -> ParseState
+    -> FontDirectory
+    -> Either DumpError Text.Builder.Builder
+dumpTable needle processedState FontDirectory{..}
+    | Just neededTable <- find ((needle ==) . Char8.unpack . getField @"tag") tableDirectory
+        = parseRequired processedState tableDirectory
+        >>= maybe (pure mempty) (first DumpParseError)
+        . dumpSubTable processedState neededTable
+    | otherwise = Left $ DumpRequestedTableMissingError needle
+
 dumpTables
-    :: Megaparsec.State ByteString Void
+    :: ParseState
     -> FontDirectory
     -> Either DumpError Text.Builder.Builder
 dumpTables processedState directory@FontDirectory{..}
-    = parseRequired >>= traverseDirectory
+    = parseRequired processedState tableDirectory >>= traverseDirectory
   where
     traverseDirectory parsedRequired =
         let initial = Right $ dumpOffsetTable directory
          in foldl' (go parsedRequired) initial tableDirectory
-    parseRequired = do
-        requiredHhea <- findRequired "hhea" hheaTableP
-        requiredHead@HeadTable{ indexToLocFormat } <-
-            findRequired "head" headTableP
-        requiredLoca <- findRequired "loca" (locaTableP indexToLocFormat)
-        pure $ RequiredTables
-            { hheaTable = requiredHhea
-            , headTable = requiredHead 
-            , locaTable = requiredLoca
-            } 
+    go _ (Left accumulator) _ = Left accumulator
+    go parsedRequired (Right accumulator) tableEntry
+        = maybe (Right accumulator) (concatDump accumulator . first DumpParseError)
+        $ dumpSubTable processedState tableEntry parsedRequired
+    concatDump accumulator builderDump = ((accumulator <> newlineBuilder) <>)
+        <$> builderDump
+
+parseRequired
+    :: (Foldable t)
+    => ParseState
+    -> t TableDirectory
+    -> Either DumpError RequiredTables
+parseRequired processedState tableDirectory = do
+    requiredHhea <- findRequired "hhea" hheaTableP
+    requiredHead@HeadTable{ indexToLocFormat } <-
+        findRequired "head" headTableP
+    requiredLoca <- findRequired "loca" (locaTableP indexToLocFormat)
+    pure $ RequiredTables
+        { hheaTable = requiredHhea
+        , headTable = requiredHead 
+        , locaTable = requiredLoca
+        } 
+  where
     findRequired tableName parser = 
         let missingError = Left $ DumpRequiredTableMissingError tableName
             parseFound tableEntry = parseTable tableEntry parser processedState
          in maybe missingError (first DumpParseError . parseFound)
             $ find ((== Char8.pack tableName) . getField @"tag") tableDirectory
-    go _ (Left accumulator) _ = Left accumulator
-    go parsedRequired (Right accumulator) tableEntry
-        = maybe (Right accumulator) (concatDump accumulator . first DumpParseError)
-        $ dumpSubTable parsedRequired tableEntry
-    concatDump accumulator builderDump = ((accumulator <> newlineBuilder) <>)
-        <$> builderDump
-    dumpSubTable RequiredTables{..} tableEntry =
-        case getField @"tag" tableEntry of
-            "cmap" -> Just $ dumpCmap <$> parseTable tableEntry cmapTableP processedState
-            "head" -> Just $ Right $ dumpHead headTable
-            "hhea" -> Just $ Right $ dumpHhea hheaTable
-            "hmtx" -> Just $ dumpHmtx
-                <$> parseTable tableEntry (hmtxTableP $ getField @"numOfLongHorMetrics" hheaTable) processedState
-            "loca" -> Just $ Right $ dumpLoca locaTable
-            "maxp" -> Just $ dumpMaxp <$> parseTable tableEntry maxpTableP processedState
-            "name" -> Just $ dumpName <$> parseTable tableEntry nameTableP processedState
-            "post" -> Just $ dumpPost <$> parseTable tableEntry postTableP processedState
-            "OS/2" -> Just $ dumpOs2 <$> parseTable tableEntry os2TableP processedState
-            "cvt " -> Just $ dumpCVTable <$> parseTable tableEntry cvTableP processedState
-            "gasp" -> Just $ dumpGASP <$> parseTable tableEntry gaspTableP processedState
-            "glyf" -> Just $ dumpGlyf <$> parseTable tableEntry (glyfTableP locaTable) processedState
-            _ -> Nothing
+
+dumpSubTable
+    :: ParseState
+    -> TableDirectory
+    -> RequiredTables
+    -> Maybe (Either ParseErrorBundle Text.Builder.Builder)
+dumpSubTable processedState tableEntry RequiredTables{..} =
+    case getField @"tag" tableEntry of
+        "cmap" -> Just $ dumpCmap <$> parseTable tableEntry cmapTableP processedState
+        "head" -> Just $ Right $ dumpHead headTable
+        "hhea" -> Just $ Right $ dumpHhea hheaTable
+        "hmtx" -> Just $ dumpHmtx
+            <$> parseTable tableEntry (hmtxTableP $ getField @"numOfLongHorMetrics" hheaTable) processedState
+        "loca" -> Just $ Right $ dumpLoca locaTable
+        "maxp" -> Just $ dumpMaxp <$> parseTable tableEntry maxpTableP processedState
+        "name" -> Just $ dumpName <$> parseTable tableEntry nameTableP processedState
+        "post" -> Just $ dumpPost <$> parseTable tableEntry postTableP processedState
+        "OS/2" -> Just $ dumpOs2 <$> parseTable tableEntry os2TableP processedState
+        "cvt " -> Just $ dumpCVTable <$> parseTable tableEntry cvTableP processedState
+        "gasp" -> Just $ dumpGASP <$> parseTable tableEntry gaspTableP processedState
+        "glyf" -> Just $ dumpGlyf <$> parseTable tableEntry (glyfTableP locaTable) processedState
+        _ -> Nothing
 
 dumpTrueType :: ByteString -> FilePath -> Either DumpError Text.Builder.Builder
 dumpTrueType ttfContents fontFile =