{-# LANGUAGE CApiFFI #-}
-- | Load system fonts configuration.
module Graphics.Text.Font.Choose.Config(Config, fini, version,
        initLoadConfig, initLoadConfigAndFonts, initFonts, reinit, bringUptoDate,
        -- For the sake of Graphics.Font.Choose.Config.Accessors
        Config', fcConfigDestroy) where

import Foreign.Ptr (Ptr, FunPtr)
import Foreign.ForeignPtr (ForeignPtr, newForeignPtr)

import Graphics.Text.Font.Choose.Result (throwBool, throwNull)

-- | Internal placeholder underlying `Config`.
data Config'
-- | holds the internal representation of a configuration.
type Config = ForeignPtr Config'


-- | Loads the default configuration file and returns the resulting configuration. Does not load any font information.
initLoadConfig :: IO Config
initLoadConfig :: IO Config
initLoadConfig = FinalizerPtr Config' -> Ptr Config' -> IO Config
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Config'
fcConfigDestroy (Ptr Config' -> IO Config) -> IO (Ptr Config') -> IO Config
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Config' -> IO (Ptr Config')
forall a. Ptr a -> IO (Ptr a)
throwNull (Ptr Config' -> IO (Ptr Config'))
-> IO (Ptr Config') -> IO (Ptr Config')
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Ptr Config')
fcInitLoadConfig -- FIXME: What's proper memory-management here?

-- | Loads the default configuration file and builds information about the available fonts. Returns the resulting configuration.
initLoadConfigAndFonts :: IO Config
initLoadConfigAndFonts :: IO Config
initLoadConfigAndFonts = FinalizerPtr Config' -> Ptr Config' -> IO Config
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Config'
fcConfigDestroy (Ptr Config' -> IO Config) -> IO (Ptr Config') -> IO Config
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Config' -> IO (Ptr Config')
forall a. Ptr a -> IO (Ptr a)
throwNull (Ptr Config' -> IO (Ptr Config'))
-> IO (Ptr Config') -> IO (Ptr Config')
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Ptr Config')
fcInitLoadConfigAndFonts -- FIXME: What's proper memory-management here?

-- | Loads the default configuration file and the fonts referenced therein and sets the default configuration to that result.
-- Returns whether this process succeeded or not. If the default configuration has already been loaded, this routine does nothing and returns True.
initFonts :: IO ()
initFonts :: IO ()
initFonts = Bool -> IO ()
throwBool (Bool -> IO ()) -> IO Bool -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Bool
fcInit
-- | Closes FontConfig's database connection.
foreign import capi "fontconfig/fontconfig.h FcFini" fini :: IO ()

-- | Returns the version number of the library.
foreign import capi "fontconfig/fontconfig.h FcGetVersion" version :: Int

-- | Forces the default configuration file to be reloaded and resets the default configuration.
-- Returns False if the configuration cannot be reloaded (due to configuration file errors,
-- allocation failures or other issues) and leaves the existing configuration unchanged. Otherwise returns True.
reinit :: IO ()
reinit :: IO ()
reinit = Bool -> IO ()
throwBool (Bool -> IO ()) -> IO Bool -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Bool
fcInitReinitialize

-- | Checks the rescan interval in the default configuration, checking the configuration
-- if the interval has passed and reloading the configuration if when any changes are detected.
-- Returns False if the configuration cannot be reloaded (see `reinit`). Otherwise returns True.
bringUptoDate :: IO ()
bringUptoDate :: IO ()
bringUptoDate = Bool -> IO ()
throwBool (Bool -> IO ()) -> IO Bool -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Bool
fcInitBringUptoDate

foreign import capi "fontconfig/fontconfig.h FcInitLoadConfig" fcInitLoadConfig :: IO (Ptr Config')
foreign import capi "fontconfig/fontconfig.h FcInitLoadConfigAndFonts" fcInitLoadConfigAndFonts :: IO (Ptr Config')
foreign import capi "fontconfig/fontconfig.h FcInit" fcInit :: IO Bool
-- | Internal ForeignPtr destructor for `Config`.
foreign import capi "fontconfig/fontconfig.h &FcConfigDestroy" fcConfigDestroy :: FunPtr (Ptr Config' -> IO ())

foreign import capi "fontconfig/fontconfig.h FcInitReinitialize" fcInitReinitialize :: IO Bool
foreign import capi "fontconfig/fontconfig.h FcInitBringUptoDate" fcInitBringUptoDate :: IO Bool