~alcinnz/fontconfig-pure

9a27693154f2ad07dcffd7e363e9a08c14c6f6c7 — Adrian Cochrane 2 years ago 6982c3d
Memory handling fixes to FcConfig bindings.
2 files changed, 29 insertions(+), 24 deletions(-)

M Graphics/Text/Font/Choose/Config.hs
M Graphics/Text/Font/Choose/Strings.hs
M Graphics/Text/Font/Choose/Config.hs => Graphics/Text/Font/Choose/Config.hs +24 -23
@@ 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

M Graphics/Text/Font/Choose/Strings.hs => Graphics/Text/Font/Choose/Strings.hs +5 -1
@@ 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