From fcf1e371e4a7d55b5ae07b90172502bc1d3e8064 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Tue, 22 Nov 2022 15:42:41 +1300
Subject: [PATCH] Remove file utility & throw memory exceptions for String
 utilities.

---
 Graphics/Text/Font/Choose/File/Atomic.hs | 45 ------------------------
 Graphics/Text/Font/Choose/Strings.hs     | 12 ++++---
 fontconfig-pure.cabal                    |  2 +-
 3 files changed, 8 insertions(+), 51 deletions(-)
 delete mode 100644 Graphics/Text/Font/Choose/File/Atomic.hs

diff --git a/Graphics/Text/Font/Choose/File/Atomic.hs b/Graphics/Text/Font/Choose/File/Atomic.hs
deleted file mode 100644
index cb2d55a..0000000
--- a/Graphics/Text/Font/Choose/File/Atomic.hs
+++ /dev/null
@@ -1,45 +0,0 @@
-module Graphics.Text.Font.Choose.File.Atomic where
-
-import Foreign.ForeignPtr
-import Foreign.Ptr (Ptr, FunPtr)
-import Foreign.C.String (CString, peekCString, withCString)
-import Control.Exception (bracket)
-
-data Atomic'
-type Atomic = ForeignPtr Atomic'
-type Atomic_ = Ptr Atomic'
-
-create :: String -> IO Atomic
-create filename = withCString filename fcAtomicCreate >>= newForeignPtr fcAtomicDestroy
-foreign import ccall "FcAtomicCreate" fcAtomicCreate :: CString -> IO Atomic_
-foreign import ccall "&FcAtomicDestroy" fcAtomicDestroy :: FunPtr (Atomic_ -> IO ())
-
-lock :: Atomic -> IO Bool
-lock = flip withForeignPtr fcAtomicLock
-foreign import ccall "FcAtomicLock" fcAtomicLock :: Atomic_ -> IO Bool
-
-newFile :: Atomic -> IO String
-newFile atomic = withForeignPtr atomic fcAtomicNewFile >>= peekCString
-foreign import ccall "FcAtomicNewFile" fcAtomicNewFile :: Atomic_ -> IO CString
-
-origFile :: Atomic -> IO String
-origFile atomic = withForeignPtr atomic fcAtomicOrigFile >>= peekCString
-foreign import ccall "FcAtomicOrigFile" fcAtomicOrigFile :: Atomic_ -> IO CString
-
-replaceOrig :: Atomic -> IO Bool
-replaceOrig = flip withForeignPtr fcAtomicReplaceOrig
-foreign import ccall "FcAtomicReplaceOrig" fcAtomicReplaceOrig :: Atomic_ -> IO Bool
-
-deleteNew :: Atomic -> IO ()
-deleteNew = flip withForeignPtr fcAtomicDeleteNew
-foreign import ccall "FcAtomicDeleteNew" fcAtomicDeleteNew :: Atomic_ -> IO ()
-
-unlock :: Atomic -> IO ()
-unlock = flip withForeignPtr fcAtomicUnlock
-foreign import ccall "FcAtomicUnlock" fcAtomicUnlock :: Atomic_ -> IO ()
-
-withLock :: Atomic -> IO () -> IO ()
-withLock atomic cb = bracket (lock atomic) (const $ unlock atomic) inner
-    where
-      inner True = cb
-      inner False = return ()
diff --git a/Graphics/Text/Font/Choose/Strings.hs b/Graphics/Text/Font/Choose/Strings.hs
index 1429722..0ca7c11 100644
--- a/Graphics/Text/Font/Choose/Strings.hs
+++ b/Graphics/Text/Font/Choose/Strings.hs
@@ -4,7 +4,7 @@ module Graphics.Text.Font.Choose.Strings (StrSet, StrSet_, StrList, StrList_,
 
 import Data.Set (Set)
 import qualified Data.Set as Set
-import Graphics.Text.Font.Choose.Result (throwNull)
+import Graphics.Text.Font.Choose.Result (throwNull, throwFalse)
 
 import Foreign.Ptr (Ptr, nullPtr)
 import Foreign.C.String (CString, withCString, peekCString)
@@ -17,19 +17,21 @@ data StrSet'
 type StrSet_ = Ptr StrSet'
 
 withNewStrSet :: (StrSet_ -> IO a) -> IO a
-withNewStrSet = bracket fcStrSetCreate fcStrSetDestroy
+withNewStrSet = bracket (throwNull <$> fcStrSetCreate) fcStrSetDestroy
 foreign import ccall "FcStrSetCreate" fcStrSetCreate :: IO StrSet_
 foreign import ccall "FcStrSetDestroy" fcStrSetDestroy :: StrSet_ -> IO ()
 
 withStrSet :: StrSet -> (StrSet_ -> IO a) -> IO a
 withStrSet strs cb = withNewStrSet $ \strs' -> do
-    forM (Set.elems strs) $ flip withCString $ fcStrSetAdd strs'
+    forM (Set.elems strs) $ \str ->
+        throwFalse <$> (withCString str $ fcStrSetAdd strs')
     cb strs'
 foreign import ccall "FcStrSetAdd" fcStrSetAdd :: StrSet_ -> CString -> IO Bool
 
 withFilenameSet :: StrSet -> (StrSet_ -> IO a) -> IO a
 withFilenameSet paths cb = withNewStrSet $ \paths' -> do
-    forM (Set.elems paths) $ flip withCString $ fcStrSetAddFilename paths'
+    forM (Set.elems paths) $ \path ->
+        throwFalse <$> (withCString path $ fcStrSetAddFilename paths')
     cb paths'
 foreign import ccall "FcStrSetAddFilename" fcStrSetAddFilename ::
     StrSet_ -> CString -> IO Bool
@@ -48,7 +50,7 @@ data StrList'
 type StrList_ = Ptr StrList'
 
 withStrList :: StrSet_ -> (StrList_ -> IO a) -> IO a
-withStrList strs = bracket (fcStrListCreate strs) fcStrListDone
+withStrList strs = bracket (throwNull <$> fcStrListCreate strs) fcStrListDone
 foreign import ccall "FcStrListCreate" fcStrListCreate :: StrSet_ -> IO StrList_
 foreign import ccall "FcStrListDone" fcStrListDone :: StrList_ -> IO ()
 
diff --git a/fontconfig-pure.cabal b/fontconfig-pure.cabal
index fe5f51f..ab21c07 100644
--- a/fontconfig-pure.cabal
+++ b/fontconfig-pure.cabal
@@ -56,7 +56,7 @@ library
                 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.Config, Graphics.Text.Font.Choose.File.Atomic
+                Graphics.Text.Font.Choose.Config
 
   c-sources:    cbits/pattern.c
 
-- 
2.30.2