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 ()