From c5f715ac7cdfb663fc84cb9fe841903b5aed99c5 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Wed, 7 Feb 2024 10:40:00 +0100
Subject: Extract some convenience parsing functions

---
 lib/Graphics/Fountainhead/Metrics.hs | 35 +++++++++++++++++++++++++++++++++++
 1 file changed, 35 insertions(+)

(limited to 'lib/Graphics/Fountainhead/Metrics.hs')

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"
-- 
cgit v1.2.3