4 files changed, 47 insertions(+), 30 deletions(-)

M Graphics/Text/Font/Choose/Config.hs
M Graphics/Text/Font/Choose/Value.hs
M cbits/pattern.c
M fontconfig-pure.cabal

@@ 5,10 5,13 @@ import Graphics.Text.Font.Choose.FontSet
 import Graphics.Text.Font.Choose.CharSet
 import Graphics.Text.Font.Choose.Pattern
 import Graphics.Text.Font.Choose.ObjectSet
+import Graphics.Text.Font.Choose.Result (throwNull, throwFalse)
 
 import Foreign.ForeignPtr
-import Foreign.Ptr (Ptr, nullPtr)
-import Foreign.C.String (CString, peekCString)
+import Foreign.Ptr (Ptr, nullPtr, FunPtr)
+import Foreign.Marshal.Alloc (alloca, allocaBytes)
+import Foreign.Storable (Storable(..))
+import Foreign.C.String (CString, peekCString, withCString)
 import System.IO.Unsafe (unsafePerformIO)
 
 type Config = ForeignPtr Config'


@@ 16,13 19,18 @@ data Config'
 type Config_ = Ptr Config'
 
 configCreate :: IO Config
-configCreate = newForeignPtr fcConfigDestroy =<< fcConfigCreate
+configCreate = newForeignPtr fcConfigDestroy =<< throwNull <$> fcConfigCreate
 foreign import ccall "FcConfigCreate" fcConfigCreate :: IO Config_
-foreign import ccall "FcConfigDestroy" fcConfigDestroy :: Config_ -> IO ()
+foreign import ccall "&FcConfigDestroy" fcConfigDestroy :: FunPtr (Config_ -> IO ())
+
+configSetCurrent :: Config -> IO ()
+configSetCurrent config = throwFalse =<< (withForeignPtr config $ fcConfigSetCurrent)
+foreign import ccall "FcConfigSetCurrent" fcConfigSetCurrent :: Config_ -> IO Bool
 
 configGetCurrent :: IO Config
-configGetCurrent = newForeignPtr_ =<< fcConfigGetCurrent
-foreign import ccall "FcConfigGetCurrent" fcConfigGetCurrent :: IO Config_
+configGetCurrent = (throwNull <$> fcConfigReference nullPtr) >>=
+    newForeignPtr fcConfigDestroy
+foreign import ccall "FcConfigReference" fcConfigReference :: Config_ -> IO Config_
 
 configUptoDate :: Config -> IO Bool
 configUptoDate config = withForeignPtr config $ fcConfigUptoDate


@@ 34,14 42,13 @@ configHome = do
     if ret == nullPtr then return Nothing else Just <$> peekCString ret
 foreign import ccall "FcConfigHome" fcConfigHome :: IO CString
 
-configEnableHome :: Bool -> IO Bool
 foreign import ccall "FcConfigEnableHome" configEnableHome :: Bool -> IO Bool
 
 configBuildFonts :: Config -> IO Bool
 configBuildFonts config = withForeignPtr config $ fcConfigBuildFonts
 configBuildFonts' :: IO Bool
 configBuildFonts' = fcConfigBuildFonts nullPtr
-foreign import ccall "FcConfigBuildFonts" :: Config_ -> IO Bool
+foreign import ccall "FcConfigBuildFonts" fcConfigBuildFonts :: Config_ -> IO Bool
 
 configGetConfigDirs :: Config -> IO StrList
 configGetConfigDirs = configStrsFunc fcConfigGetConfigDirs


@@ 73,8 80,8 @@ configGetFonts config set = do
     ret <- withForeignPtr config $ flip fcConfigGetFonts $ fromEnum set
     thawFontSet ret
 configGetFonts' :: SetName -> IO FontSet
-configGetFonts' set = thawFontSet =<< fcConfigGetFonts nullPtr $ fromEnum set
-foreign import ccall "FcConfigGetFonts" fcConfigGetFonts -> Config_ -> Int -> IO FontSet_
+configGetFonts' set = thawFontSet_ $ fcConfigGetFonts nullPtr $ fromEnum set
+foreign import ccall "FcConfigGetFonts" fcConfigGetFonts :: Config_ -> Int -> IO FontSet_
 
 configGetRescanInterval :: Config -> IO Int
 configGetRescanInterval = flip withForeignPtr $ fcConfigGetRescanInterval


@@ 135,7 142,7 @@ configSubstitute config p kind = unsafePerformIO $
         ok <- fcConfigSubstitute config' p' $ fromEnum kind
         if ok then Just <$> thawPattern p' else return Nothing
 configSubstitute' :: Pattern -> MatchKind -> Maybe Pattern
-configSubsitute' p kind = unsafePerformIO $ withPattern p $ \p' -> do
+configSubstitute' p kind = unsafePerformIO $ withPattern p $ \p' -> do
     ok <- fcConfigSubstitute nullPtr p' $ fromEnum kind
     if ok then Just <$> thawPattern p' else return Nothing
 foreign import ccall "FcConfigSubstitute" fcConfigSubstitute ::


@@ 152,22 159,23 @@ fontMatch' pattern = unsafePerformIO $ withPattern pattern $ \pattern' -> alloca
     ret <- fcFontMatch nullPtr pattern' res'
     res <- peek res'
     if res == 0 then Just <$> thawPattern ret else return Nothing
-foreign import ccall "FcFontMatch" fcFontMatch :: Config_ -> Pattern_ -> Ptr Int -> IO Pattern_
+foreign import ccall "FcFontMatch" fcFontMatch ::
+    Config_ -> Pattern_ -> Ptr Int -> IO Pattern_
 
 fontSort :: Config -> Pattern -> Bool -> CharSet -> Maybe FontSet
 fontSort config pattern trim csp = unsafePerformIO $ withForeignPtr config $ \config' ->
     withPattern pattern $ \pattern' -> withCharSet csp $ \csp' -> alloca $ \res' -> do
         ret <- fcFontSort config' pattern' trim csp' res'
         res <- peek res'
-        if res == 0 then Just <$> thawPattern ret else return Nothing
+        if res == 0 then Just <$> thawFontSet ret else return Nothing
 fontSort' :: Pattern -> Bool -> CharSet -> Maybe FontSet
-fontSort' pattern trim csp = unsafePerformIO $ withPattern $ \pattern' ->
+fontSort' pattern trim csp = unsafePerformIO $ withPattern pattern $ \pattern' ->
     withCharSet csp $ \csp' -> alloca $ \res' -> do
         ret <- fcFontSort nullPtr pattern' trim csp' res'
         res <- peek res'
-        if res == 0 then Just <$> thawPattern ret else return Nothing
+        if res == 0 then Just <$> thawFontSet ret else return Nothing
 foreign import ccall "FcFontSort" fcFontSort ::
-    Config_ -> Pattern_ -> Bool -> CharSet_ -> Ptr Int -> IO Pattern_
+    Config_ -> Pattern_ -> Bool -> CharSet_ -> Ptr Int -> IO FontSet_
 
 fontRenderPrepare :: Config -> Pattern -> Pattern -> Pattern
 fontRenderPrepare config pat font = unsafePerformIO $ withForeignPtr config $ \config' ->


@@ 185,13 193,14 @@ foreign import ccall "FcFontRenderPrepare" fcFontRenderPrepare ::
 fontList :: Config -> Pattern -> ObjectSet -> FontSet
 fontList config p os = unsafePerformIO $ withForeignPtr config $ \config' ->
     withPattern p $ \p' -> withObjectSet os $ \os' -> do
-        ret <- fontList config' p' os'
+        ret <- fcFontList config' p' os'
         thawFontSet ret
 fontList' :: Pattern -> ObjectSet -> FontSet
 fontList' p os = unsafePerformIO $ withPattern p $ \p' -> withObjectSet os $ \os' -> do
-    ret <- fontList nullPtr p' os'
+    ret <- fcFontList nullPtr p' os'
     thawFontSet ret
-foreign import ccall "FcFontList" fcFontList :: Config_ -> Pattern_ -> ObjectSet_ -> IO FontSet_
+foreign import ccall "FcFontList" fcFontList ::
+    Config_ -> Pattern_ -> ObjectSet_ -> IO FontSet_
 
 configGetFilename :: Config -> String -> String
 configGetFilename config name = unsafePerformIO $ withForeignPtr config $ \config' ->


@@ 199,7 208,7 @@ configGetFilename config name = unsafePerformIO $ withForeignPtr config $ \confi
         ret <- fcConfigGetFilename config' name'
         peekCString ret
 configGetFilename' :: String -> String
-configGetFilename' name = unsafePerformIO $ withCString name $ \name' ->
+configGetFilename' name = unsafePerformIO $ withCString name $ \name' -> do
     ret <- fcConfigGetFilename nullPtr name'
     peekCString ret
 foreign import ccall "FcConfigGetFilename" fcConfigGetFilename :: Config_ -> CString -> IO CString


@@ 218,7 227,7 @@ configParseAndLoadFromMemory config buffer complain = withForeignPtr config $ \c
     withCString buffer $ \buffer' ->
         fcConfigParseAndLoadFromMemory config' buffer' complain
 configParseAndLoadFromMemory' :: String -> Bool -> IO Bool
-configParseAndLoadFromMemory' buffer complain = withCString buffer $ \buffer' -=>
+configParseAndLoadFromMemory' buffer complain = withCString buffer $ \buffer' ->
     fcConfigParseAndLoadFromMemory nullPtr buffer' complain
 foreign import ccall "FcConfigParseAndLoadFromMemory" fcConfigParseAndLoadFromMemory ::
     Config_ -> CString -> Bool -> IO Bool


@@ 239,27 248,29 @@ configSetSysRoot' val = withCString val $ fcConfigSetSysRoot nullPtr
 foreign import ccall "FcConfigSetSysRoot" fcConfigSetSysRoot :: Config_ -> CString -> IO ()
 
 configGetFileInfo :: Config -> IO [(FilePath, String, Bool)]
-configGetFileInfo config = withForeignPtr config $ \config' -> alloca $ \iter' -> do
+configGetFileInfo config =
+  withForeignPtr config $ \config' -> allocaBytes configFileInfoIter'Size $ \iter' -> do
     fcConfigFileInfoIterInit config' iter'
-    let readEnt = alloca $ \name' -> alloca $ \description' -> alloca $ \enabled' -> do
-        ok <- fcConfigFileInfoIterGet config' iter' name' description' enabled'
+    let readEnt = alloca $ \name' -> alloca $ \description' -> alloca $ \enabled' -> do {
+        ok <- fcConfigFileInfoIterGet config' iter' name' description' enabled';
         if ok then do
             name <- peekCString =<< peek name'
             description <- peekCString =<< peek description'
             enabled <- peek enabled'
             return $ Just (name, description, enabled)
-        else return Nothing
-    let go = do
-        ent' <- readEnt
+        else return Nothing}
+    let go = do {
+        ent' <- readEnt;
         case ent' of
             Just ent -> do
                 ok <- fcConfigFileInfoIterNext config' iter'
                 ents <- if ok then go else return []
                 return (ent : ents)
-            Nothing -> return []
+            Nothing -> return []}
     go
 data ConfigFileInfoIter'
-type ConfigFileInfoIter_ = Ptr ConfigFileInfo'
+foreign import ccall "size_ConfigFileInfoIter" configFileInfoIter'Size :: Int
+type ConfigFileInfoIter_ = Ptr ConfigFileInfoIter'
 foreign import ccall "FcConfigFileInfoIterInit" fcConfigFileInfoIterInit ::
     Config_ -> ConfigFileInfoIter_ -> IO ()
 foreign import ccall "FcConfigFileInfoIterNext" fcConfigFileInfoIterNext ::

@@ 17,6 17,7 @@ import Foreign.C.String (withCString, peekCString)
 
 import GHC.Generics (Generic)
 import Data.Hashable (Hashable)
+import Graphics.Text.Font.Choose.Result (throwNull)
 
 data Value = ValueVoid
     | ValueInt Int

@@ 22,3 22,7 @@ int size_matrix() {
 int size_PatternIter() {
     return sizeof(FcPatternIter);
 }
+
+int size_ConfigFileInfoIter() {
+    return sizeof(FcConfigFileInfoIter);
+}

@@ 55,7 55,8 @@ 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.FontSet
+                Graphics.Text.Font.Choose.Pattern, Graphics.Text.Font.Choose.FontSet,
+                Graphics.Text.Font.Choose.Config
 
   c-sources:    cbits/pattern.c