5 files changed, 31 insertions(+), 22 deletions(-)

M Graphics/Text/Font/Choose/CharSet.hs
M Graphics/Text/Font/Choose/Config.hs
M Graphics/Text/Font/Choose/FontSet.hs
M Graphics/Text/Font/Choose/FontSet/API.hs
M fontconfig-pure.cabal

@@ 9,6 9,7 @@ import Data.Word (Word32)
 import Foreign.Ptr
 import Foreign.ForeignPtr (newForeignPtr, withForeignPtr)
 import Control.Exception (bracket)
+import Foreign.Storable (peek)
 import Control.Monad (forM)
 import Foreign.Marshal.Alloc (alloca)
 import Foreign.Marshal.Array (allocaArray)


@@ 93,3 94,5 @@ foreign import ccall "my_FcCharSetIterDone" fcCharSetIterDone :: Word32 -> Bool
 
 thawCharSet_ :: IO CharSet_ -> IO CharSet
 thawCharSet_ cb = bracket (throwNull <$> cb) fcCharSetDestroy thawCharSet
+thawCharSet' :: Ptr CharSet_ -> IO CharSet
+thawCharSet' = thawCharSet_ . peek

@@ 243,23 243,23 @@ foreign import ccall "FcFontMatch" fcFontMatch ::
 -- otherwise the results will not be correct.
 fontSort :: Config -> Pattern -> Bool -> Maybe (FontSet, CharSet)
 fontSort config pattern trim = unsafePerformIO $ withForeignPtr config $ \config' ->
-    withPattern pattern $ \pattern' -> withNewCharSet $ \csp' -> alloca $ \res' -> do
-        ret <- fcFontSort config' pattern' trim csp' res'
-        throwPtr res' $ do
-            x <- thawFontSet_ $ pure $ throwNull ret
-            y <- thawCharSet $ throwNull csp'
-            return (x, y)
+    withPattern pattern $ \pattern' -> alloca $ \csp' -> alloca $ \res' -> do
+            ret <- fcFontSort config' pattern' trim csp' res'
+            throwPtr res' $ do
+                x <- thawFontSet_ $ pure ret
+                y <- thawCharSet' csp'
+                return (x, y)
 -- | Variant of `fontSort` which operates upon current configuration.
 fontSort' :: Pattern -> Bool -> Maybe (FontSet, CharSet)
 fontSort' pattern trim = unsafePerformIO $ withPattern pattern $ \pattern' ->
-    withNewCharSet $ \csp' -> alloca $ \res' -> do
+    alloca $ \csp' -> alloca $ \res' -> do
         ret <- fcFontSort nullPtr pattern' trim csp' res'
         throwPtr res' $ do
-            x <- thawFontSet_ $ pure $ throwNull ret
-            y <- thawCharSet $ throwNull csp'
+            x <- thawFontSet_ $ pure ret
+            y <- thawCharSet' csp'
             return (x, y)
 foreign import ccall "FcFontSort" fcFontSort ::
-    Config_ -> Pattern_ -> Bool -> CharSet_ -> Ptr Word8 -> IO FontSet_
+    Config_ -> Pattern_ -> Bool -> Ptr CharSet_ -> Ptr Word8 -> IO FontSet_
 
 -- | Creates a new pattern consisting of elements of font not appearing in pat,
 -- elements of pat not appearing in font and the best matching value from pat

@@ 7,7 7,7 @@ import Graphics.Text.Font.Choose.Result (throwFalse, throwNull)
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
 import Foreign.Storable (pokeElemOff, sizeOf)
 import Foreign.Marshal.Alloc (allocaBytes)
-import Foreign.Marshal.Array (peekArray)
+import Foreign.Marshal.Array (peekArray, allocaArray)
 import Control.Monad (forM)
 import Control.Exception (bracket)
 import System.IO.Unsafe (unsafeInterleaveIO)


@@ 46,7 46,7 @@ foreign import ccall "FcFontSetAdd" fcFontSetAdd :: FontSet_ -> Pattern_ -> IO B
 
 withFontSets :: [FontSet] -> (Ptr FontSet_ -> Int -> IO a) -> IO a
 withFontSets fontss cb = let n = length fontss in
-    allocaBytes (sizeOf (undefined :: FontSet_) * n) $ \fontss' ->
+    allocaArray n $ \fontss' ->
         withFontSets' fontss 0 fontss' $ cb fontss' n
 withFontSets' :: [FontSet] -> Int -> Ptr FontSet_ -> IO a -> IO a
 withFontSets' [] _ _ cb = cb

@@ 60,18 60,24 @@ foreign import ccall "FcFontSetMatch" fcFontSetMatch ::
 -- the return value from multiple `fontSort` calls, applications cannot modify
 -- these patterns. Instead, they should be passed, along with pattern to
 -- `fontRenderPrepare` which combines them into a complete pattern.
-fontSetSort :: Config -> [FontSet] -> Pattern -> Bool -> CharSet -> Maybe FontSet
-fontSetSort config fontss pattern trim csp = unsafePerformIO $
+fontSetSort :: Config -> [FontSet] -> Pattern -> Bool -> Maybe (FontSet, CharSet)
+fontSetSort config fontss pattern trim = unsafePerformIO $
     withForeignPtr config $ \config' -> withFontSets fontss $ \fontss' n ->
-        withPattern pattern $ \pattern' -> withCharSet csp $ \csp' -> alloca $ \res' -> do
+        withPattern pattern $ \pattern' -> alloca $ \csp' -> alloca $ \res' -> do
             ret' <- fcFontSetSort config' fontss' n pattern' trim csp' res'
-            throwPtr res' $ thawFontSet_ $ pure ret'
+            throwPtr res' $ do
+                x <- thawFontSet_ $ pure ret'
+                y <- thawCharSet' csp'
+                return (x, y)
 -- | Variant of `fontSetSort` operating upon registered default `Config`.
-fontSetSort' :: [FontSet] -> Pattern -> Bool -> CharSet -> Maybe FontSet
-fontSetSort' fontss pattern trim csp = unsafePerformIO $
+fontSetSort' :: [FontSet] -> Pattern -> Bool -> Maybe (FontSet, CharSet)
+fontSetSort' fontss pattern trim = unsafePerformIO $
     withFontSets fontss $ \fontss' n -> withPattern pattern $ \pattern' ->
-        withCharSet csp $ \csp' -> alloca $ \res' -> do
+        alloca $ \csp' -> alloca $ \res' -> do
             ret' <- fcFontSetSort nullPtr fontss' n pattern' trim csp' res'
-            throwPtr res' $ thawFontSet_ $ pure ret'
+            throwPtr res' $ do
+                x <- thawFontSet_ $ pure ret'
+                y <- thawCharSet' csp'
+                return (x, y)
 foreign import ccall "FcFontSetSort" fcFontSetSort :: Config_ -> Ptr FontSet_
-    -> Int -> Pattern_ -> Bool -> CharSet_ -> Ptr Word8 -> IO FontSet_
+    -> Int -> Pattern_ -> Bool -> Ptr CharSet_ -> Ptr Word8 -> IO FontSet_

@@ 10,7 10,7 @@ name:                fontconfig-pure
 -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             0.3.0.1
+version:             0.4.0.0
 
 -- A short (one-line) description of the package.
 synopsis:            Pure-functional language bindings to FontConfig