From 9a27693154f2ad07dcffd7e363e9a08c14c6f6c7 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Mon, 21 Nov 2022 16:53:18 +1300
Subject: [PATCH] Memory handling fixes to FcConfig bindings.

---
 Graphics/Text/Font/Choose/Config.hs  | 47 ++++++++++++++--------------
 Graphics/Text/Font/Choose/Strings.hs |  6 +++-
 2 files changed, 29 insertions(+), 24 deletions(-)

diff --git a/Graphics/Text/Font/Choose/Config.hs b/Graphics/Text/Font/Choose/Config.hs
index c15d432..af3ca0f 100644
--- a/Graphics/Text/Font/Choose/Config.hs
+++ b/Graphics/Text/Font/Choose/Config.hs
@@ -44,10 +44,10 @@ foreign import ccall "FcConfigHome" fcConfigHome :: IO CString
 
 foreign import ccall "FcConfigEnableHome" configEnableHome :: Bool -> IO Bool
 
-configBuildFonts :: Config -> IO Bool
-configBuildFonts config = withForeignPtr config $ fcConfigBuildFonts
-configBuildFonts' :: IO Bool
-configBuildFonts' = fcConfigBuildFonts nullPtr
+configBuildFonts :: Config -> IO ()
+configBuildFonts config = throwFalse =<< (withForeignPtr config $ fcConfigBuildFonts)
+configBuildFonts' :: IO ()
+configBuildFonts' = throwFalse =<< fcConfigBuildFonts nullPtr
 foreign import ccall "FcConfigBuildFonts" fcConfigBuildFonts :: Config_ -> IO Bool
 
 configGetConfigDirs :: Config -> IO StrList
@@ -59,28 +59,30 @@ foreign import ccall "FcConfigGetConfigDirs" fcConfigGetConfigDirs :: Config_ ->
 configGetFontDirs :: Config -> IO StrList
 configGetFontDirs = configStrsFunc fcConfigGetFontDirs
 configGetFontDirs' :: IO StrList
-configGetFontDirs' = thawStrList =<< fcConfigGetFontDirs nullPtr
+configGetFontDirs' = thawStrList_ $ fcConfigGetFontDirs nullPtr
 foreign import ccall "FcConfigGetFontDirs" fcConfigGetFontDirs :: Config_ -> IO StrList_
 
 configGetConfigFiles :: Config -> IO StrList
 configGetConfigFiles = configStrsFunc fcConfigGetConfigFiles
 configGetConfigFiles' :: IO StrList
-configGetConfigFiles' = thawStrList =<< fcConfigGetConfigFiles nullPtr
+configGetConfigFiles' = thawStrList_ $ fcConfigGetConfigFiles nullPtr
 foreign import ccall "FcConfigGetConfigFiles" fcConfigGetConfigFiles :: Config_ -> IO StrList_
 
 configGetCacheDirs :: Config -> IO StrList
 configGetCacheDirs = configStrsFunc fcConfigGetCacheDirs
 configGetCacheDirs' :: IO StrList
-configGetCacheDirs' = thawStrList =<< fcConfigGetCacheDirs nullPtr
+configGetCacheDirs' = thawStrList_ $ fcConfigGetCacheDirs nullPtr
 foreign import ccall "FcConfigGetCacheDirs" fcConfigGetCacheDirs :: Config_ -> IO StrList_
 
-data SetName = SetSystem | SetApplication deriving (Enum)
+data SetName = SetSystem | SetApplication deriving (Enum, Eq, Show, Read)
 configGetFonts :: Config -> SetName -> IO FontSet
 configGetFonts config set = do
     ret <- withForeignPtr config $ flip fcConfigGetFonts $ fromEnum set
-    thawFontSet ret
+    thawFontSet $ throwNull ret
 configGetFonts' :: SetName -> IO FontSet
-configGetFonts' set = thawFontSet_ $ fcConfigGetFonts nullPtr $ fromEnum set
+configGetFonts' set = do
+    ret <- fcConfigGetFonts nullPtr $ fromEnum set
+    thawFontSet $ throwNull ret
 foreign import ccall "FcConfigGetFonts" fcConfigGetFonts :: Config_ -> Int -> IO FontSet_
 
 configGetRescanInterval :: Config -> IO Int
@@ -90,20 +92,21 @@ configGetRescanInterval' = fcConfigGetRescanInterval nullPtr
 foreign import ccall "FcConfigGetRescanInterval" fcConfigGetRescanInterval ::
     Config_ -> IO Int
 
-configSetRescanInterval :: Config -> Int -> IO Bool
+configSetRescanInterval :: Config -> Int -> IO ()
 configSetRescanInterval config val =
-    withForeignPtr config $ flip fcConfigSetRescanInterval val
-configSetRescanInterval' :: Int -> IO Bool
-configSetRescanInterval' = fcConfigSetRescanInterval nullPtr
+    throwFalse =<< (withForeignPtr config $ flip fcConfigSetRescanInterval val)
+configSetRescanInterval' :: Int -> IO ()
+configSetRescanInterval' v = throwFalse =<< fcConfigSetRescanInterval nullPtr v
 foreign import ccall "FcConfigSetRescanInterval" fcConfigSetRescanInterval ::
     Config_ -> Int -> IO Bool
 
-configAppFontAddFile :: Config -> String -> IO Bool
-configAppFontAddFile config file =
-    withForeignPtr config $ \config' -> withCString file $ \file' ->
-        fcConfigAppFontAddFile config' file'
-configAppFontAddFile' :: String -> IO Bool
-configAppFontAddFile' = flip withCString $ fcConfigAppFontAddFile nullPtr
+configAppFontAddFile :: Config -> String -> IO ()
+configAppFontAddFile config file = throwFalse =<<
+    (withForeignPtr config $ \config' -> withCString file $ \file' ->
+        fcConfigAppFontAddFile config' file')
+configAppFontAddFile' :: String -> IO ()
+configAppFontAddFile' file =
+    throwFalse =<< (withCString file $ fcConfigAppFontAddFile nullPtr)
 foreign import ccall "FcConfigAppFontAddFile" fcConfigAppFontAddFile ::
     Config_ -> CString -> IO Bool
 
@@ -281,6 +284,4 @@ foreign import ccall "FcConfigFileInfoIterGet" fcConfigFileInfoIterGet ::
 ------
 
 configStrsFunc :: (Config_ -> IO StrList_) -> Config -> IO StrList
-configStrsFunc cb config = do
-    ret <- withForeignPtr config cb
-    thawStrList ret
+configStrsFunc cb config = thawStrList_ $ withForeignPtr config cb
diff --git a/Graphics/Text/Font/Choose/Strings.hs b/Graphics/Text/Font/Choose/Strings.hs
index b6dac5e..1429722 100644
--- a/Graphics/Text/Font/Choose/Strings.hs
+++ b/Graphics/Text/Font/Choose/Strings.hs
@@ -1,5 +1,6 @@
 module Graphics.Text.Font.Choose.Strings (StrSet, StrSet_, StrList, StrList_,
-    withStrSet, withFilenameSet, thawStrSet, thawStrSet_, withStrList, thawStrList) where
+    withStrSet, withFilenameSet, thawStrSet, thawStrSet_,
+    withStrList, thawStrList, thawStrList_) where
 
 import Data.Set (Set)
 import qualified Data.Set as Set
@@ -65,3 +66,6 @@ thawStrList strs' = do
             return (item : items)
 foreign import ccall "FcStrListFirst" fcStrListFirst :: StrList_ -> IO ()
 foreign import ccall "FcStrListNext" fcStrListNext :: StrList_ -> IO CString
+
+thawStrList_ :: IO StrList_ -> IO StrList
+thawStrList_ cb = bracket (throwNull <$> cb) fcStrListDone thawStrList
-- 
2.30.2