1 files changed, 38 insertions(+), 35 deletions(-)

M Graphics/Text/Font/Choose/Config.hs

@@ 5,15 5,17 @@ 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, FunPtr)
-import Foreign.Marshal.Alloc (alloca, allocaBytes)
+import Foreign.Marshal.Alloc (alloca, allocaBytes, free)
 import Foreign.Storable (Storable(..))
 import Foreign.C.String (CString, peekCString, withCString)
 import System.IO.Unsafe (unsafePerformIO)
 
+import Control.Exception (bracket)
+import Graphics.Text.Font.Choose.Result (throwNull, throwFalse, throwPtr)
+
 type Config = ForeignPtr Config'
 data Config'
 type Config_ = Ptr Config'


@@ 110,44 112,48 @@ configAppFontAddFile' file =
 foreign import ccall "FcConfigAppFontAddFile" fcConfigAppFontAddFile ::
     Config_ -> CString -> IO Bool
 
-configAppFontAddDir :: Config -> String -> IO Bool
-configAppFontAddDir config file =
-    withForeignPtr config $ \config' -> withCString file $ fcConfigAppFontAddDir config'
-configAppFontAddDir' :: String -> IO Bool
-configAppFontAddDir' = flip withCString $ fcConfigAppFontAddDir nullPtr
+configAppFontAddDir :: Config -> String -> IO ()
+configAppFontAddDir config file = throwFalse =<<
+    (withForeignPtr config $ \config' -> withCString file $ fcConfigAppFontAddDir config')
+configAppFontAddDir' :: String -> IO ()
+configAppFontAddDir' v = throwFalse =<< (withCString v $ fcConfigAppFontAddDir nullPtr)
 foreign import ccall "FcConfigAppFontAddDir" fcConfigAppFontAddDir ::
     Config_ -> CString -> IO Bool
 
-configAppFontClear :: Config -> IO Bool
-configAppFontClear = flip withForeignPtr fcConfigAppFontClear
-configAppFontClear' :: IO Bool
-configAppFontClear' = fcConfigAppFontClear nullPtr
+configAppFontClear :: Config -> IO ()
+configAppFontClear config = throwFalse =<< withForeignPtr config fcConfigAppFontClear
+configAppFontClear' :: IO ()
+configAppFontClear' = throwFalse =<< fcConfigAppFontClear nullPtr
 foreign import ccall "FcConfigAppFontClear" fcConfigAppFontClear :: Config_ -> IO Bool
 
 data MatchKind = MatchPattern | MatchFont | MatchScan deriving Enum
-configSubstituteWithPat :: Config -> Pattern -> Pattern -> MatchKind -> Maybe Pattern
+configSubstituteWithPat :: Config -> Pattern -> Pattern -> MatchKind -> Pattern
 configSubstituteWithPat config p p_pat kind = unsafePerformIO $
     withForeignPtr config $ \config' -> withPattern p $ \p' ->
         withPattern p_pat $ \p_pat' -> do
             ok <- fcConfigSubstituteWithPat config' p' p_pat' $ fromEnum kind
-            if ok then Just <$> thawPattern p' else return Nothing
-configSubstituteWithPat' :: Pattern -> Pattern -> MatchKind -> Maybe Pattern
+            throwFalse ok
+            thawPattern p'
+configSubstituteWithPat' :: Pattern -> Pattern -> MatchKind -> Pattern
 configSubstituteWithPat' p p_pat kind = unsafePerformIO $
     withPattern p $ \p' -> withPattern p_pat $ \p_pat' -> do
         ok <- fcConfigSubstituteWithPat nullPtr p' p_pat' $ fromEnum kind
-        if ok then Just <$> thawPattern p' else return Nothing
+        throwFalse ok
+        thawPattern p'
 foreign import ccall "FcConfigSubstituteWithPat" fcConfigSubstituteWithPat ::
     Config_ -> Pattern_ -> Pattern_ -> Int -> IO Bool
 
-configSubstitute :: Config -> Pattern -> MatchKind -> Maybe Pattern
+configSubstitute :: Config -> Pattern -> MatchKind -> Pattern
 configSubstitute config p kind = unsafePerformIO $
     withForeignPtr config $ \config' -> withPattern p $ \p' -> do
         ok <- fcConfigSubstitute config' p' $ fromEnum kind
-        if ok then Just <$> thawPattern p' else return Nothing
-configSubstitute' :: Pattern -> MatchKind -> Maybe Pattern
+        throwFalse ok
+        thawPattern p'
+configSubstitute' :: Pattern -> MatchKind -> Pattern
 configSubstitute' p kind = unsafePerformIO $ withPattern p $ \p' -> do
     ok <- fcConfigSubstitute nullPtr p' $ fromEnum kind
-    if ok then Just <$> thawPattern p' else return Nothing
+    throwFalse ok
+    thawPattern p'
 foreign import ccall "FcConfigSubstitute" fcConfigSubstitute ::
     Config_ -> Pattern_ -> Int -> IO Bool
 


@@ 155,13 161,11 @@ fontMatch :: Config -> Pattern -> Maybe Pattern
 fontMatch config pattern = unsafePerformIO $ withForeignPtr config $ \config' ->
     withPattern pattern $ \pattern' -> alloca $ \res' -> do
         ret <- fcFontMatch config' pattern' res'
-        res <- peek res'
-        if res == 0 then Just <$> thawPattern ret else return Nothing
+        throwPtr res' $ thawPattern_ $ pure ret
 fontMatch' :: Pattern -> Maybe Pattern
 fontMatch' pattern = unsafePerformIO $ withPattern pattern $ \pattern' -> alloca $ \res' -> do
     ret <- fcFontMatch nullPtr pattern' res'
-    res <- peek res'
-    if res == 0 then Just <$> thawPattern ret else return Nothing
+    throwPtr res' $ thawPattern_ $ pure ret
 foreign import ccall "FcFontMatch" fcFontMatch ::
     Config_ -> Pattern_ -> Ptr Int -> IO Pattern_
 


@@ 169,14 173,12 @@ 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 <$> thawFontSet ret else return Nothing
+        throwPtr res' $ thawFontSet_ $ pure ret
 fontSort' :: Pattern -> Bool -> CharSet -> Maybe FontSet
 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 <$> thawFontSet ret else return Nothing
+        throwPtr res' $ thawFontSet_ $ pure ret
 foreign import ccall "FcFontSort" fcFontSort ::
     Config_ -> Pattern_ -> Bool -> CharSet_ -> Ptr Int -> IO FontSet_
 


@@ 184,12 186,12 @@ fontRenderPrepare :: Config -> Pattern -> Pattern -> Pattern
 fontRenderPrepare config pat font = unsafePerformIO $ withForeignPtr config $ \config' ->
     withPattern pat $ \pat' -> withPattern font $ \font' -> do
         ret <- fcFontRenderPrepare config' pat' font'
-        thawPattern ret
+        thawPattern_ $ pure $ throwNull ret
 fontRenderPrepare' :: Pattern -> Pattern -> Pattern
 fontRenderPrepare' pat font = unsafePerformIO $ withPattern pat $ \pat' ->
     withPattern font $ \font' -> do
         ret <- fcFontRenderPrepare nullPtr pat' font'
-        thawPattern ret
+        thawPattern_ $ pure ret
 foreign import ccall "FcFontRenderPrepare" fcFontRenderPrepare ::
     Config_ -> Pattern_ -> Pattern_ -> IO Pattern_
 


@@ 197,11 199,11 @@ fontList :: Config -> Pattern -> ObjectSet -> FontSet
 fontList config p os = unsafePerformIO $ withForeignPtr config $ \config' ->
     withPattern p $ \p' -> withObjectSet os $ \os' -> do
         ret <- fcFontList config' p' os'
-        thawFontSet ret
+        thawFontSet_ $ pure ret
 fontList' :: Pattern -> ObjectSet -> FontSet
 fontList' p os = unsafePerformIO $ withPattern p $ \p' -> withObjectSet os $ \os' -> do
     ret <- fcFontList nullPtr p' os'
-    thawFontSet ret
+    thawFontSet_ $ pure ret
 foreign import ccall "FcFontList" fcFontList ::
     Config_ -> Pattern_ -> ObjectSet_ -> IO FontSet_
 


@@ 209,12 211,13 @@ configGetFilename :: Config -> String -> String
 configGetFilename config name = unsafePerformIO $ withForeignPtr config $ \config' ->
     withCString name $ \name' -> do
         ret <- fcConfigGetFilename config' name'
-        peekCString ret
+        peekCString' ret
 configGetFilename' :: String -> String
 configGetFilename' name = unsafePerformIO $ withCString name $ \name' -> do
     ret <- fcConfigGetFilename nullPtr name'
-    peekCString ret
+    peekCString' ret
 foreign import ccall "FcConfigGetFilename" fcConfigGetFilename :: Config_ -> CString -> IO CString
+peekCString' txt = bracket (pure $ throwNull txt) free peekCString
 
 configParseAndLoad :: Config -> String -> Bool -> IO Bool
 configParseAndLoad config name complain = withForeignPtr config $ \config' ->


@@ 238,9 241,9 @@ foreign import ccall "FcConfigParseAndLoadFromMemory" fcConfigParseAndLoadFromMe
 configGetSysRoot :: Config -> IO String
 configGetSysRoot = flip withForeignPtr $ \config' -> do
     ret <- fcConfigGetSysRoot config'
-    peekCString ret
+    peekCString $ throwNull ret
 configGetSysRoot' :: IO String
-configGetSysRoot' = peekCString =<< fcConfigGetSysRoot nullPtr
+configGetSysRoot' = (peekCString .throwNull) =<< fcConfigGetSysRoot nullPtr
 foreign import ccall "FcConfigGetSysRoot" fcConfigGetSysRoot :: Config_ -> IO CString
 
 configSetSysRoot :: Config -> String -> IO ()