module Graphics.Text.Font.Choose.ObjectSet where

import Foreign.Ptr (Ptr)
import Foreign.C.String (CString, withCString)

import Control.Monad (forM)
import Control.Exception (bracket)
import Graphics.Text.Font.Choose.Result (throwFalse, throwNull)

-- | An `ObjectSet` holds a list of pattern property names;
-- it is used to indicate which properties are to be returned in the patterns
-- from `FontList`.
type ObjectSet = [String]

------
--- LowLevel
------
data ObjectSet'
type ObjectSet_ = Ptr ObjectSet'

withObjectSet :: ObjectSet -> (ObjectSet_ -> IO a) -> IO a
withObjectSet :: ObjectSet -> (ObjectSet_ -> IO a) -> IO a
withObjectSet objs :: ObjectSet
objs cb :: ObjectSet_ -> IO a
cb = (ObjectSet_ -> IO a) -> IO a
forall a. (ObjectSet_ -> IO a) -> IO a
withNewObjectSet ((ObjectSet_ -> IO a) -> IO a) -> (ObjectSet_ -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \objs' :: ObjectSet_
objs' -> do
    ObjectSet -> (String -> IO (IO ())) -> IO [IO ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ObjectSet
objs ((String -> IO (IO ())) -> IO [IO ()])
-> (String -> IO (IO ())) -> IO [IO ()]
forall a b. (a -> b) -> a -> b
$ \obj :: String
obj -> String -> (CString -> IO (IO ())) -> IO (IO ())
forall a. String -> (CString -> IO a) -> IO a
withCString String
obj ((CString -> IO (IO ())) -> IO (IO ()))
-> (CString -> IO (IO ())) -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ \obj' :: CString
obj' ->
        Bool -> IO ()
throwFalse (Bool -> IO ()) -> IO Bool -> IO (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ObjectSet_ -> CString -> IO Bool
fcObjectSetAdd ObjectSet_
objs' CString
obj'
    ObjectSet_ -> IO a
cb ObjectSet_
objs'
foreign import ccall "FcObjectSetAdd" fcObjectSetAdd ::
    ObjectSet_ -> CString -> IO Bool

withNewObjectSet :: (ObjectSet_ -> IO a) -> IO a
withNewObjectSet :: (ObjectSet_ -> IO a) -> IO a
withNewObjectSet = IO ObjectSet_
-> (ObjectSet_ -> IO ()) -> (ObjectSet_ -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (ObjectSet_ -> ObjectSet_
forall a. Ptr a -> Ptr a
throwNull (ObjectSet_ -> ObjectSet_) -> IO ObjectSet_ -> IO ObjectSet_
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ObjectSet_
fcObjectSetCreate) ObjectSet_ -> IO ()
fcObjectSetDestroy
foreign import ccall "FcObjectSetCreate" fcObjectSetCreate :: IO ObjectSet_
foreign import ccall "FcObjectSetDestroy" fcObjectSetDestroy :: ObjectSet_ -> IO ()