From 58198ed89ecc315519d91044bed43d4b0275e990 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Fri, 18 Nov 2022 13:36:38 +1300
Subject: [PATCH] Refine FontConfig FreeType utility bindings, so it compiles &
 correct manages memory

---
 Graphics/Text/Font/Choose/CharSet.hs  |  6 ++-
 Graphics/Text/Font/Choose/FreeType.hs | 60 ---------------------------
 Graphics/Text/Font/Choose/Pattern.hs  |  2 +-
 fontconfig-pure.cabal                 |  2 +-
 4 files changed, 7 insertions(+), 63 deletions(-)
 delete mode 100644 Graphics/Text/Font/Choose/FreeType.hs

diff --git a/Graphics/Text/Font/Choose/CharSet.hs b/Graphics/Text/Font/Choose/CharSet.hs
index 67aa4d2..f0a29ab 100644
--- a/Graphics/Text/Font/Choose/CharSet.hs
+++ b/Graphics/Text/Font/Choose/CharSet.hs
@@ -2,6 +2,7 @@ module Graphics.Text.Font.Choose.CharSet where
 
 import Data.Set (Set)
 import qualified Data.Set as Set
+import Graphics.Text.Font.Choose.Result (throwNull)
 
 import Data.Word (Word32)
 import Foreign.Ptr
@@ -21,7 +22,7 @@ data CharSet'
 type CharSet_ = Ptr CharSet'
 
 withNewCharSet :: (CharSet_ -> IO a) -> IO a
-withNewCharSet cb = bracket fcCharSetCreate fcCharSetDestroy cb
+withNewCharSet cb = bracket (throwNull <$> fcCharSetCreate) fcCharSetDestroy cb
 foreign import ccall "FcCharSetCreate" fcCharSetCreate :: IO CharSet_
 foreign import ccall "FcCharSetDestroy" fcCharSetDestroy :: CharSet_ -> IO ()
 
@@ -48,3 +49,6 @@ foreign import ccall "FcCharSetFirstPage" fcCharSetFirstPage ::
 foreign import ccall "FcCharSetNextPage" fcCharSetNextPage ::
     CharSet_ -> Ptr Word32 -> Ptr Word32 -> IO Word32
 foreign import ccall "my_FcCHARSET_MAP_SIZE" fcCHARSET_MAP_SIZE :: Int
+
+thawCharSet_ :: IO CharSet_ -> IO CharSet
+thawCharSet_ cb = bracket (throwNull <$> cb) fcCharSetDestroy thawCharSet
diff --git a/Graphics/Text/Font/Choose/FreeType.hs b/Graphics/Text/Font/Choose/FreeType.hs
deleted file mode 100644
index 320b092..0000000
--- a/Graphics/Text/Font/Choose/FreeType.hs
+++ /dev/null
@@ -1,60 +0,0 @@
--- NOTE: Not tested
-module Graphics.Text.Font.Choose.FreeType where
-
-import Graphics.Text.Font.Choose.CharSet (CharSet, CharSet_, thawCharSet)
-import Graphics.Text.Font.Choose.Pattern (Pattern, Pattern_, thawPattern)
-import Graphics.Text.Font.Choose.FontSet (FontSet, FontSet_, withFontSet, thawFontSet)
-import FreeType.Core.Base (FT_Face(..))
-import Data.Word (Word32, Word)
-
-import Foreign.Ptr (nullPtr)
-import Foreign.Storable (peek)
-import Foreign.Marshal.Alloc (alloca)
-import Foreign.C.String (CString, withCString)
-import System.IO.Unsafe (unsafePerformIO)
-
-c2w :: Char -> Word32
-c2w = fromIntegral
-
-ftCharIndex :: FT_Face -> Char -> Word
-ftCharIndex face = fcFreeTypeCharIndex face . c2w
-foreign import ccall "FcFreeTypeCharIndex" fcFreeTypeCharIndex :: FT_Face -> Word32 -> Word
-
-ftCharSet :: FT_Face -> CharSet
-ftCharSet face = unsafePerformIO $ thawCharSet $ fcFreeTypeCharSet face nullPtr
-foreign import ccall "FcFreeTypeCharSet" fcFreeTypeCharSet
-    :: FT_Face -> Ptr () -> FcCharSet_ -- 2nd arg's deprecated!
-
-ftCharSetAndSpacing :: FT_Face -> (CharSet, Int)
-ftCharSetAndSpacing face = unsafePerformIO $ alloca $ \spacing' -> do
-    chars' <- fcFreeTypeCharSetAndSpacing face nullPtr spacing'
-    chars <- thawCharSet chars'
-    spacing <- peek spacing'
-    return (chars, spacing)
-foreign import ccall "FcFreeTypeCharSetAndSpacing" fcFreeTypeCharSetAndSpacing ::
-    FT_Face -> Ptr () -> Ptr Int -> IO CharSet_ -- 2nd arg's deprecated!
-
-ftQuery :: FilePath -> Int -> IO (Pattern, Int)
-ftQuery filename id = withCString filename $ \filename' -> alloca $ \count' -> do
-    pattern' <- fcFreeTypeQuery filename' id nullPtr count'
-    pattern <- thawPattern pattern'
-    count <- peek count'
-    return (pattern, count)
-foreign import call "FcFreeTypeQuery" fcFreeTypeQuery ::
-    CString -> Int -> Ptr () -> Ptr Int -> IO Pattern_ -- 3rd arg's deprecated!
-
-ftQueryAll :: FilePath -> Int -> IO (FontSet, Int)
-ftQueryAll filename id = withCString filename $ \filename' -> alloca \count' ->
-    withFontSet [] $ \fonts' -> do
-        fcFreeTypeQueryAll filename' id nullPtr count' fonts'
-        fonts <- thawFontSet fonts'
-        count <- peek count'
-        return (fonts, count)
-foreign import ccall "FcFreeTypeQueryAll" fcFreeTypeQueryAll ::
-    CString -> Int -> Ptr () -> Ptr Count -> FontSet_ -> IO Word -- 2nd arg's deprecated!
-
-ftQueryFace :: FT_Face -> FilePath -> Int -> Pattern
-ftQueryFace face filename id = withCString filename $ \filename' ->
-    thawPattern $ fcFreeTypeQueryFace face filename' id nullPtr
-foreign import ccall "FcFreeTypeQueryFace" fcFreeTypeQueryFace ::
-    FT_Face -> CString -> Int -> Ptr () -> Pattern_ -- Final arg's deprecated!
diff --git a/Graphics/Text/Font/Choose/Pattern.hs b/Graphics/Text/Font/Choose/Pattern.hs
index 7293c93..03b92e9 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, thawPattern, patternAsPointer) where
+    Pattern_, withPattern, thawPattern, thawPattern_, patternAsPointer) where
 
 import Prelude hiding (filter)
 import Data.List (nub)
diff --git a/fontconfig-pure.cabal b/fontconfig-pure.cabal
index b558998..2814804 100644
--- a/fontconfig-pure.cabal
+++ b/fontconfig-pure.cabal
@@ -51,7 +51,7 @@ cabal-version:       >=1.10
 
 library
   -- Modules exported by the library.
-  exposed-modules:      Graphics.Text.Font.Choose.Result,
+  exposed-modules:      Graphics.Text.Font.Choose.Result, FreeType.FontConfig,
                 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,
-- 
2.30.2