Extract some convenience parsing functions

1 files changed, 35 insertions, 0 deletions

diff --git a/lib/Graphics/Fountainhead/Metrics.hs b/lib/Graphics/Fountainhead/Metrics.hs
index abf80b7..ddebf85 100644
--- a/lib/Graphics/Fountainhead/Metrics.hs
+++ b/lib/Graphics/Fountainhead/Metrics.hs
@@ -7,11 +7,22 @@
 module Graphics.Fountainhead.Metrics
     ( FontBBox(..)
     , FontDescriptor(..)
+    , MetricsError(..)
     , Number
     , FontDescriptorFlag(..)
+    , collectMetrics
     ) where
 
+import Data.ByteString (ByteString)
 import Data.Text (Text)
+import Graphics.Fountainhead.TrueType (findTableByTag)
+import Graphics.Fountainhead.Parser
+    ( ParseErrorBundle
+    , nameTableP
+    , parseFontDirectory
+    , parseTable
+    )
+import qualified Text.Megaparsec as Megaparsec
 
 type Number = Double
 
@@ -66,3 +77,27 @@ data FontDescriptor = FontDescriptor
     , ascender :: Number
     , descender :: Number
     } deriving (Eq, Show)
+
+data MetricsError
+    = MetricsParseError ParseErrorBundle
+    | MetricsRequiredTableMissingError String
+    deriving Eq
+
+instance Show MetricsError
+  where
+    show (MetricsParseError errorBundle) = Megaparsec.errorBundlePretty errorBundle
+    show (MetricsRequiredTableMissingError tableName) =
+        "Required table " <> tableName <> " is missing."
+
+collectMetrics :: FilePath -> ByteString -> Either MetricsError FontDescriptor
+collectMetrics fontFile ttfContents =
+    case parseFontDirectory fontFile ttfContents of
+        (_processedState, Left initialResult) -> Left
+            $ MetricsParseError initialResult
+        (processedState, Right initialResult)
+            | Just tableEntry <- findTableByTag "name" initialResult
+            , Right parsedNameTable <- parseTable tableEntry nameTableP processedState ->
+                pure $ FontDescriptor
+                    {
+                    }
+            | otherwise -> Left $ MetricsRequiredTableMissingError "name"