From db90fbd0f2143c28aaa9d49f91e6376109518b57 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Thu, 17 Nov 2022 16:53:07 +1300
Subject: [PATCH] Get FontSet module compiling (need to review memory
 management responsibilities).

---
 Graphics/Text/Font/Choose/FontSet.hs | 22 +++++++++++++---------
 Graphics/Text/Font/Choose/Pattern.hs |  2 +-
 fontconfig-pure.cabal                |  2 +-
 3 files changed, 15 insertions(+), 11 deletions(-)

diff --git a/Graphics/Text/Font/Choose/FontSet.hs b/Graphics/Text/Font/Choose/FontSet.hs
index 5af77f3..812a37c 100644
--- a/Graphics/Text/Font/Choose/FontSet.hs
+++ b/Graphics/Text/Font/Choose/FontSet.hs
@@ -2,10 +2,11 @@
 module Graphics.Text.Font.Choose.FontSet where
 
 import Graphics.Text.Font.Choose.Pattern
-import Graphics.Text.Font.Choose.Config
+--import Graphics.Text.Font.Choose.Config
 import Graphics.Text.Font.Choose.ObjectSet
+import Graphics.Text.Font.Choose.Result (throwFalse)
 
-import Foreign.Ptr (Ptr, castPtr)
+import Foreign.Ptr (Ptr, castPtr, nullPtr)
 import Foreign.Storable (pokeElemOff, sizeOf, peek)
 import Foreign.Marshal.Alloc (allocaBytes)
 import Foreign.Marshal.Array (advancePtr)
@@ -14,7 +15,7 @@ import Control.Exception (bracket)
 
 type FontSet = [Pattern]
 
-fontSetList :: Config -> [FontSet] -> Pattern -> ObjectSet
+{-fontSetList :: Config -> [FontSet] -> Pattern -> ObjectSet
 fontSetList config fontss pattern objs = withConfig config $ \config' ->
     withFontSets fontss $ \fontss' -> withPattern $ \pattern' ->
         withObjectSet objs $ \objs' -> do
@@ -39,7 +40,7 @@ fontSetSort config fontss pattern trim csp cb = withConfig config $ \config' ->
                 res <- peek res'
                 ret <- if res == 0 then Just <$> thawFontSet ret' else return Nothing
                 fcFontSetDestroy ret'
-                return ret
+                return ret-}
 
 ------
 --- Low-level
@@ -53,19 +54,22 @@ foreign import ccall "FcFontSetCreate" fcFontSetCreate :: IO FontSet_
 foreign import ccall "FcFontSetDestroy" fcFontSetDestroy :: FontSet_ -> IO ()
 
 withFontSet :: FontSet -> (FontSet_ -> IO a) -> IO a
-withFontSet fonts cb = withNewFontSet $ \fonts' ->
-    forM fonts $ \font -> (fcFontSetAdd fonts' =<< patternAsPointer font)
+withFontSet fonts cb = withNewFontSet $ \fonts' -> do
+    forM fonts $ \font -> do
+        font' <- patternAsPointer font
+        throwFalse <$> fcFontSetAdd fonts' font'
     cb fonts'
+foreign import ccall "FcFontSetAdd" fcFontSetAdd :: FontSet_ -> Pattern_ -> IO Bool
 
 withFontSets :: [FontSet] -> (Ptr FontSet_ -> 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'
 withFontSets' :: [FontSet] -> Int -> Ptr FontSet_ -> IO a -> IO a
 withFontSets' [] _ _ cb = cb
 withFontSets' (fonts:fontss) i fontss' cb = withFontSet fonts $ \fonts' -> do
     pokeElemOff fontss' i fonts'
-    withFontSets fontss (succ i) fontss' cb
+    withFontSets' fontss (succ i) fontss' cb
 
 thawFontSet :: FontSet_ -> IO FontSet
 thawFontSet fonts' = do
@@ -73,4 +77,4 @@ thawFontSet fonts' = do
     array <- peek $ castPtr $ advancePtr fonts' 2
     if n == 0 || array == nullPtr
     then return []
-    else forM [0..pred n] $ \i -> thawPattern (advancePtr array i)
+    else forM [0..pred n] $ \i -> thawPattern =<< peek (advancePtr array i)
diff --git a/Graphics/Text/Font/Choose/Pattern.hs b/Graphics/Text/Font/Choose/Pattern.hs
index bb6f9f7..7293c93 100644
--- a/Graphics/Text/Font/Choose/Pattern.hs
+++ b/Graphics/Text/Font/Choose/Pattern.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE DeriveGeneric #-}
 module Graphics.Text.Font.Choose.Pattern (Pattern(..), Binding(..), equalSubset,
-    Pattern_, withPattern) where
+    Pattern_, withPattern, thawPattern, patternAsPointer) where
 
 import Prelude hiding (filter)
 import Data.List (nub)
diff --git a/fontconfig-pure.cabal b/fontconfig-pure.cabal
index aeead85..19336bf 100644
--- a/fontconfig-pure.cabal
+++ b/fontconfig-pure.cabal
@@ -55,7 +55,7 @@ library
                 Graphics.Text.Font.Choose.ObjectSet, Graphics.Text.Font.Choose.CharSet,
                 Graphics.Text.Font.Choose.Strings, Graphics.Text.Font.Choose.Range,
                 Graphics.Text.Font.Choose.LangSet, Graphics.Text.Font.Choose.Value,
-                Graphics.Text.Font.Choose.Pattern
+                Graphics.Text.Font.Choose.Pattern, Graphics.Text.Font.Choose.FontSet
 
   c-sources:    cbits/pattern.c
 
-- 
2.30.2