From 27013b25cfe0eadb5661d7fbb910792d797e5e5c Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <alcinnz@lavabit.com>
Date: Mon, 7 Nov 2022 22:47:40 +1300
Subject: [PATCH] Correctly decode Harfbuzz output structs.

I didn't consider the presence of private-fields before!
---
 Data/Text/Glyphize/Buffer.hs | 50 +++++++++++++++++++++++++++++++++---
 1 file changed, 46 insertions(+), 4 deletions(-)

diff --git a/Data/Text/Glyphize/Buffer.hs b/Data/Text/Glyphize/Buffer.hs
index 7aad0d6..4d3f713 100644
--- a/Data/Text/Glyphize/Buffer.hs
+++ b/Data/Text/Glyphize/Buffer.hs
@@ -299,7 +299,7 @@ foreign import ccall "hb_buffer_guess_segment_properties" hb_buffer_guess_segmen
 data GlyphInfo = GlyphInfo {
     codepoint :: Word32,
     -- ^ Glyph index (or unicode codepoint)
-    cluster :: Word32
+    cluster :: Word32,
     -- ^ The index of the character in the original text that corresponds to
     -- this `GlyphInfo`. More than one `GlyphInfo` may have the same `cluster`
     -- value if they resulted from the same character, & when more than one
@@ -308,8 +308,34 @@ data GlyphInfo = GlyphInfo {
     -- By default some characters are merged into the same cluster even when
     -- they are seperate glyphs, `Buffer`'s `clusterLevel` property allows
     -- selecting more fine grained cluster handling.
-} deriving (Show, Read, Eq, Generic)
-instance GStorable GlyphInfo
+    unsafeToBreak :: Bool,
+    unsafeToConcat :: Bool,
+    safeToInsertTatweel :: Bool
+} deriving (Show, Read, Eq)
+instance Storable GlyphInfo where
+    sizeOf _ = sizeOf (undefined :: Word32) * 5
+    alignment _ = alignment (undefined :: Word32)
+    peek ptr = do
+        let ptr' :: Ptr Word32
+            ptr' = castPtr ptr
+        -- Ignore private fields.
+        codepoint' <- ptr' `peekElemOff` 0
+        mask <- ptr' `peekElemOff` 1
+        cluster' <- ptr' `peekElemOff` 2
+        return $ GlyphInfo codepoint' cluster' (mask `testBit` 1) (mask `testBit` 2) (mask `testBit` 3)
+    poke ptr (GlyphInfo codepoint' cluster' flag1 flag2 flag3) = do
+        -- Zero private fields.
+        let ptr' :: Ptr Word32
+            ptr' = castPtr ptr
+        pokeElemOff ptr' 0 codepoint'
+        pokeElemOff ptr' 1 $ Prelude.foldl (.|.) 0 [
+            if flag1 then 1 else 0,
+            if flag2 then 2 else 0,
+            if flag3 then 4 else 0
+          ]
+        pokeElemOff ptr' 2 cluster'
+        pokeElemOff ptr' 3 0
+        pokeElemOff ptr' 4 0
 glyphInfos buf' = do
     arr <- hb_buffer_get_glyph_infos buf' nullPtr
     length <- hb_buffer_get_length buf'
@@ -335,7 +361,23 @@ data GlyphPos = GlyphPos {
     -- ^ How much the glyph moves on the Y-axis before drawing it, this should
     -- not effect how much the line advances.
 } deriving (Show, Read, Eq, Generic)
-instance GStorable GlyphPos
+instance Storable GlyphPos where
+    sizeOf _ = sizeOf (undefined :: Int32) * 5
+    alignment _ = alignment (undefined :: Int32)
+    peek ptr = let ptr' = castPtr ptr in do
+        x_advance' <- ptr' `peekElemOff` 0
+        y_advance' <- ptr' `peekElemOff` 1
+        x_offset' <- ptr' `peekElemOff` 2
+        y_offset' <- ptr' `peekElemOff` 3
+        return $ GlyphPos x_advance' y_advance' x_offset' y_offset'
+    poke ptr (GlyphPos x_advance' y_advance' x_offset' y_offset') = do
+        let ptr' :: Ptr Int32
+            ptr' = castPtr ptr
+        pokeElemOff ptr' 0 x_advance'
+        pokeElemOff ptr' 1 y_advance'
+        pokeElemOff ptr' 2 x_offset'
+        pokeElemOff ptr' 3 y_offset'
+        pokeElemOff ptr' 4 0 -- Zero private field.
 glyphsPos buf' = do
     arr <- hb_buffer_get_glyph_positions buf' nullPtr
     length <- hb_buffer_get_length buf'
-- 
2.30.2