From b863f00dc226d2d60e49bf99c10cca78e58ba490 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Thu, 17 Nov 2022 22:08:12 +1300
Subject: [PATCH] Refine memory management of FontSets (until I've enabled
 FcConfig code).

---
 Graphics/Text/Font/Choose/FontSet.hs | 34 ++++++++++++++++------------
 fontconfig-pure.cabal                |  2 ++
 2 files changed, 21 insertions(+), 15 deletions(-)

diff --git a/Graphics/Text/Font/Choose/FontSet.hs b/Graphics/Text/Font/Choose/FontSet.hs
index 812a37c..542858e 100644
--- a/Graphics/Text/Font/Choose/FontSet.hs
+++ b/Graphics/Text/Font/Choose/FontSet.hs
@@ -4,7 +4,7 @@ module Graphics.Text.Font.Choose.FontSet where
 import Graphics.Text.Font.Choose.Pattern
 --import Graphics.Text.Font.Choose.Config
 import Graphics.Text.Font.Choose.ObjectSet
-import Graphics.Text.Font.Choose.Result (throwFalse)
+import Graphics.Text.Font.Choose.Result (throwFalse, throwNull)
 
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
 import Foreign.Storable (pokeElemOff, sizeOf, peek)
@@ -16,11 +16,14 @@ import Control.Exception (bracket)
 type FontSet = [Pattern]
 
 {-fontSetList :: Config -> [FontSet] -> Pattern -> ObjectSet
-fontSetList config fontss pattern objs = withConfig config $ \config' ->
-    withFontSets fontss $ \fontss' -> withPattern $ \pattern' ->
-        withObjectSet objs $ \objs' -> do
-            ret <- fcFontSetList config' fontss' n pattern' objs'
-            thawFontSet ret
+fontSetList config fontss pattern objs = unsafePerformIO $ withConfig config $ \config' ->
+    withFontSets fontss $ \fontss' n -> withPattern $ \pattern' ->
+        withObjectSet objs $ \objs' ->
+            thawFontSet_ $ fcFontSetList config' fontss' n pattern' objs'
+fontSetList' :: [FontSet] -> Pattern -> ObjectSet
+fontSetList' fontss pattern objs = unsafePerformIO $ withFontSets fontss $ \fontss' n ->
+    withPattern $ \pattern' -> withObjectSet objs $ \objs' ->
+        thawFontSet_ $ fcFontSetList nullPtr fontss' n pattern' objs'
 foreign import ccall "FcFontSetList" fcFontSetList ::
     Config_ -> Ptr FontSet_ -> Int -> Pattern_ -> ObjectSet_ -> IO FontSet_
 
@@ -28,19 +31,18 @@ fontSetMatch :: Config -> [FontSet] -> Pattern -> Maybe Pattern
 fontSetMatch config fontss pattern = withConfig config $ \config' ->
     withFontSets fontss $ \fontss' -> withPattern $ \pattern' ->  alloca $ \res' -> do
         ret <- fcFontSetMatch config' fontss' n pattern' res'
-        res <- peek res'
-        -- FIXME Is this correct success code?
-        if res == 0 then Just <$> thawPattern ret else return Nothing
+        throwPtr res' $ thawPattern_ $ pure ret
+foreign import ccall "FcFontSetMatch" fcFontSetMatch ::
+    Config_ -> Ptr FontSet_ -> Int -> Pattern_ -> IO Pattern_
 
 fontSetSort :: Config -> [FontSet] -> Pattern -> Bool -> CharSet -> Maybe FontSet
 fontSetSort config fontss pattern trim csp cb = withConfig config $ \config' ->
         withFontSets fontss $ \fontss' withPattern $ \pattern' ->
             withCharSet csp $ \csp' -> alloca $ \res' -> do
                 ret' <- fcFontSetSort config' fontss' n pattern' trim csp' res'
-                res <- peek res'
-                ret <- if res == 0 then Just <$> thawFontSet ret' else return Nothing
-                fcFontSetDestroy ret'
-                return ret-}
+                throwPtr res' $ thawFontSet_ $ pure ret'
+foreign import ccall "FcFontSetSort" fcFontSetSort ::
+    Config_ -> Ptr FontSet_ -> Int -> Pattern_ -> Bool -> CharSet_ -> Ptr Int -> IO FontSet_ -}
 
 ------
 --- Low-level
@@ -61,10 +63,10 @@ withFontSet fonts cb = withNewFontSet $ \fonts' -> do
     cb fonts'
 foreign import ccall "FcFontSetAdd" fcFontSetAdd :: FontSet_ -> Pattern_ -> IO Bool
 
-withFontSets :: [FontSet] -> (Ptr FontSet_ -> IO a) -> IO a
+withFontSets :: [FontSet] -> (Ptr FontSet_ -> Int -> IO a) -> IO a
 withFontSets fontss cb = let n = length fontss in
     allocaBytes (sizeOf (undefined :: FontSet_) * n) $ \fontss' ->
-        withFontSets' fontss 0 fontss' $ cb fontss'
+        withFontSets' fontss 0 fontss' $ cb fontss' n
 withFontSets' :: [FontSet] -> Int -> Ptr FontSet_ -> IO a -> IO a
 withFontSets' [] _ _ cb = cb
 withFontSets' (fonts:fontss) i fontss' cb = withFontSet fonts $ \fonts' -> do
@@ -78,3 +80,5 @@ thawFontSet fonts' = do
     if n == 0 || array == nullPtr
     then return []
     else forM [0..pred n] $ \i -> thawPattern =<< peek (advancePtr array i)
+thawFontSet_ :: IO FontSet_ -> IO FontSet
+thawFontSet_ cb = bracket (throwNull <$> cb) fcFontSetDestroy thawFontSet
diff --git a/fontconfig-pure.cabal b/fontconfig-pure.cabal
index 19336bf..b558998 100644
--- a/fontconfig-pure.cabal
+++ b/fontconfig-pure.cabal
@@ -70,6 +70,8 @@ library
                         linear >= 1.0.1 && <2, freetype2 >= 0.2 && < 0.3,
                         hashable >= 1.3 && <2
 
+  pkgconfig-depends:    fontconfig
+
   -- Directories containing source files.
   -- hs-source-dirs:
 
-- 
2.30.2