{-# LANGUAGE CApiFFI #-}
-- | APIs for retrieving configuration
-- This is seperate from Graphics.Text.Font.Choose.Config to avoid cyclic dependencies.
module Graphics.Text.Font.Choose.Config.Accessors(
        configCreate, setCurrent, current, uptodate, home, enableHome, buildFonts,
        configDirs, fontDirs, configFiles, cacheDirs, fonts, rescanInterval,
        setRescanInterval, appFontAddFile, appFontAddDir, appFontClear, substitute,
        fontMatch, fontSort, fontRenderPrepare, fontList, filename, parseAndLoad,
        parseAndLoadFromMemory, sysroot, setSysroot, SetName(..), MatchKind(..)
    ) where

import Graphics.Text.Font.Choose.Config
import Graphics.Text.Font.Choose.FontSet
import Graphics.Text.Font.Choose.Pattern
import Graphics.Text.Font.Choose.CharSet
import Graphics.Text.Font.Choose.ObjectSet

import Foreign.Ptr (Ptr, nullPtr)
import Foreign.ForeignPtr (newForeignPtr, withForeignPtr)
import Foreign.C.String (CString, withCString, peekCString)
--import Foreign.C.ConstPtr (ConstPtr)
--import Foreign.C.Types (CChar)

import Graphics.Text.Font.Choose.Result (throwBool, throwNull)
import Graphics.Text.Font.Choose.Internal.FFI (peekCString', fromMessageIO0,
                withMessage, withForeignPtr', fromMessage0, fromMessage)

-- | Creates an empty configuration.
configCreate :: IO Config
configCreate = newForeignPtr fcConfigDestroy =<< throwNull =<< fcConfigCreate
foreign import capi "fontconfig/fontconfig.h FcConfigCreate" fcConfigCreate :: IO (Ptr Config')

-- | Sets the current default configuration to config. Implicitly calls FcConfigBuildFonts
-- if necessary, and FcConfigReference() to inrease the reference count in config since 2.12.0.
setCurrent :: Config -> IO ()
setCurrent conf = throwBool =<< withForeignPtr conf fcConfigSetCurrent
foreign import capi "fontconfig/fontconfig.h FcConfigSetCurrent" fcConfigSetCurrent :: Ptr Config' -> IO Bool

-- | Returns the current default configuration.
current :: IO Config
current = newForeignPtr fcConfigDestroy =<< throwNull =<< fcConfigReference nullPtr
foreign import capi "fontconfig/fontconfig.h FcConfigReference" fcConfigReference :: Ptr Config' -> IO (Ptr Config')

-- | Checks all of the files related to config and returns whether any of them has
-- been modified since the configuration was created.
uptodate :: Config -> IO Bool
uptodate conf = withForeignPtr conf fcConfigUptoDate
foreign import capi "fontconfig/fontconfig.h FcConfigUptoDate" fcConfigUptoDate :: Ptr Config' -> IO Bool

-- | Return the current user's home directory, if it is available & if using it is enabled.
home :: String
home = peekCString' fcConfigHome
foreign import capi "fontconfig/fontconfig.h FcConfigHome" fcConfigHome :: CString

-- | If given True, then Fontconfig will use various files which are specified
-- relative to the user's home directory (using the ~ notation in the configuration).
-- When its False, then all use of the home directory in these contexts will be disabled.
-- The previous setting of the value is returned.
foreign import capi "fontconfig/fontconfig.h FcConfigEnableHome" enableHome :: Bool -> IO Bool

-- | Builds the set of available fonts for the given configuration.
-- Note that any changes to the configuration after this call
-- (through parseAndLoad or parseAndLoadFromMemory) have indeterminate effects.
-- (On the other hand, application fonts can still be modified through
-- appFontAddFile, appFontAddDir and appFontClear).
buildFonts :: Config -> IO ()
buildFonts conf = throwBool =<< withForeignPtr conf fcConfigBuildFonts
foreign import capi "fontconfig/fontconfig.h FcConfigBuildFonts" fcConfigBuildFonts :: Ptr Config' -> IO Bool

-- | Returns the list of font directories specified in the configuration files.
-- Does not include any subdirectories.
configDirs :: Config -> IO [String]
configDirs conf =
    fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetConfigDirs conf' len
foreign import capi "fontconfig-wrap.h" fcConfigGetConfigDirs :: Ptr Config' -> Ptr Int -> IO CString

-- | Returns the list of font directories. This includes the configured font directories
-- along with any directories below those in the filesystem.
fontDirs :: Config -> IO [String]
fontDirs conf =
    fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetFontDirs conf' len
foreign import capi "fontconfig-wrap.h" fcConfigGetFontDirs :: Ptr Config' -> Ptr Int -> IO CString

-- | Returns the list of known configuration files used to generate given config.
configFiles :: Config -> IO [String]
configFiles conf =
    fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetConfigFiles conf' len
foreign import capi "fontconfig-wrap.h" fcConfigGetConfigFiles :: Ptr Config' -> Ptr Int -> IO CString

-- | returns a string list containing all of the directories that fontconfig will
-- search when attempting to load a cache file for a font directory.
cacheDirs :: Config -> IO [String]
cacheDirs conf =
    fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetCacheDirs conf' len
foreign import capi "fontconfig-wrap.h" fcConfigGetCacheDirs :: Ptr Config' -> Ptr Int -> IO CString

-- | Which set of fonts to retrieve.
data SetName = System -- ^ Fonts installed into the OS.
    | App -- ^ Fonts provided by this process.
    deriving (Read, Show, Eq, Enum)
-- | Returns one of the two sets of fonts from the configuration as specified by set.
fonts :: Config -> SetName -> IO FontSet
fonts conf setname =
    fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetFonts conf' (setname == System) len
foreign import capi "fontconfig-wrap.h" fcConfigGetFonts :: Ptr Config' -> Bool -> Ptr Int -> IO CString

-- | Returns the interval between automatic checks of the configuration (in seconds) specified
-- in config. The configuration is checked during a call to FcFontList when this interval has
-- passed since the last check. An interval setting of zero disables automatic checks.
rescanInterval :: Config -> IO Int
rescanInterval = flip withForeignPtr fcConfigGetRescanInterval
foreign import capi "fontconfig/fontconfig.h FcConfigGetRescanInterval" fcConfigGetRescanInterval ::
        Ptr Config' -> IO Int

-- | Sets the rescan interval. An interval setting of zero disables automatic checks.
setRescanInterval :: Config -> Int -> IO ()
setRescanInterval conf period =
    throwBool =<< withForeignPtr conf (flip fcConfigSetRescanInterval period)
foreign import capi "fontconfig/fontconfig.h FcConfigSetRescanInterval" fcConfigSetRescanInterval ::
        Ptr Config' -> Int -> IO Bool

-- | Adds an application-specific font to the configuration.
appFontAddFile :: Config -> FilePath -> IO ()
appFontAddFile conf file = throwBool =<< withForeignPtr conf (\conf' ->
        withCString file $ \file' -> fcConfigAppFontAddFile conf' file')
foreign import capi "fontconfig/fontconfig.h FcConfigAppFontAddFile" fcConfigAppFontAddFile ::
        Ptr Config' -> CString -> IO Bool

-- | Scans the specified directory for fonts, adding each one found to the application-specific set of fonts.
appFontAddDir :: Config -> FilePath -> IO ()
appFontAddDir conf file = throwBool =<< withForeignPtr conf (\conf' ->
        withCString file $ \file' -> fcConfigAppFontAddDir conf' file')
foreign import capi "fontconfig/fontconfig.h FcConfigAppFontAddDir" fcConfigAppFontAddDir ::
        Ptr Config' -> CString -> IO Bool

-- | Clears the set of application-specific fonts.
appFontClear :: Config -> IO ()
appFontClear = flip withForeignPtr fcConfigAppFontClear
foreign import capi "fontconfig/fontconfig.h FcConfigAppFontClear" fcConfigAppFontClear ::
        Ptr Config' -> IO ()


-- | Which pattern modifications to apply during `substituteWithPat`.
data MatchKind = MatchPattern -- ^ Applies pattern operations.
    | MatchFont -- ^ Applies font operations.
    deriving (Read, Show, Eq, Enum)
-- | Performs the sequence of pattern modification operations tagged by `kind`.
-- If kind is MatchPattern then those tagged as pattern operations are applied,
-- else if kind is MatchFont those tagged as font operations are applied
-- & p_pat is used for &lt;test&gt; elements with target=pattern.
substitute :: Config -> Pattern -> Maybe Pattern -> MatchKind -> Pattern
substitute conf p (Just p_pat) kind =
    fromMessage0 $ flip withForeignPtr' conf $ \conf' -> flip withMessage [p, p_pat] $ \msg len -> 
        fcConfigSubstituteWithPat conf' msg len (kind == MatchFont)
substitute conf p Nothing kind =
    fromMessage0 $ flip withForeignPtr' conf $ \conf' -> flip withMessage [p] $ \msg len ->
        fcConfigSubstituteWithPat conf' msg len (kind == MatchFont)
foreign import capi "fontconfig-wrap.h" fcConfigSubstituteWithPat ::
    Ptr Config' -> CString -> Int -> Bool -> Ptr Int -> CString

-- | Finds the font in sets most closely matching pattern and returns the result
-- of fontRenderPrepare for that font and the provided pattern.
fontMatch :: Config -> Pattern -> Maybe Pattern
fontMatch conf pat = fromMessage $ flip withMessage pat $ withForeignPtr' fcFontMatch conf
foreign import capi "fontconfig-wrap.h" fcFontMatch :: Ptr Config' -> CString -> Int -> Ptr Int -> CString

-- | Returns the list of fonts sorted by closeness to p.
-- If trim is FcTrue, elements in the list which don't include Unicode coverage
-- not provided by earlier elements in the list are elided.
-- The union of Unicode coverage of all of the fonts is returned.
--
-- The returned FcFontSet references FcPattern structures which may be shared by the
-- return value from multiple FcFontSort calls, applications must not modify these patterns.
fontSort :: Config -> Pattern -> Bool -> Maybe (FontSet, CharSet')
fontSort conf pat trim = fromMessage $ (flip withMessage pat $ withForeignPtr' fcFontSort conf) trim
foreign import capi "fontconfig-wrap.h" fcFontSort ::
    Ptr Config' -> CString -> Int -> Bool -> Ptr Int -> CString

-- | Creates a new pattern consisting of elements of font not appearing in pat, elements of pat
-- not appearing in font and the best matching value from pat for elements appearing in both.
-- The result is passed to FcConfigSubstituteWithPat with kind FcMatchFont and then returned.
fontRenderPrepare :: Config -> Pattern -> Pattern -> Pattern
fontRenderPrepare conf pat font = fromMessage0 $ flip withMessage [pat, font] $
        withForeignPtr' fcFontRenderPrepare conf
foreign import capi "fontconfig-wrap.h" fcFontRenderPrepare ::
    Ptr Config' -> CString -> Int -> Ptr Int -> CString

-- | Selects fonts matching p, creates patterns from those fonts containing only
-- the given objects and returns the set of unique such patterns.
fontList :: Config -> Pattern -> ObjectSet -> FontSet
fontList conf pat os = fromMessage0 $ flip withMessage (pat, os) $ withForeignPtr' fcFontList conf
foreign import capi "fontconfig-wrap.h" fcFontList :: Ptr Config' -> CString -> Int -> Ptr Int -> CString

-- | Given the specified external entity name, return the associated filename. This provides
-- applications a way to convert various configuration file references into filename form.
--
-- An empty name indicates that the default configuration file should be used;
-- which file this references can be overridden with the FONTCONFIG_FILE environment variable.
-- Next, if the name starts with ~, it refers to a file in the current users home directory.
-- Otherwise if the name doesn't start with '/', it refers to a file in the default config dir;
-- the built-in default directory can be overridden with the FONTCONFIG_PATH environment variable.
--
-- The result of this function is affected by the FONTCONFIG_SYSROOT environment variable
-- or equivalent functionality.
filename :: Config -> FilePath -> IO FilePath
filename conf path =
    peekCString =<< withForeignPtr conf (\_ -> withCString path $ fcConfigGetFilename)
foreign import capi "fontconfig/fontconfig.h FcConfigFilename" fcConfigGetFilename ::
    CString -> IO CString -- FIXME: Recent docs say it's "Get" now...

-- | Walks the configuration in 'path' and constructs the internal representation in 'conf'.
-- Any include files referenced from within 'path' will be loaded and parsed.
-- If 'complain' is False, no warning will be displayed if 'path' does not exist.
-- Error and warning messages will be output to stderr.
-- Throws an exception if some error occurred while loading the file, either a parse error,
-- semantic error or allocation failure. After all configuration files or strings have been loaded,
-- with FcConfigParseAndLoad inclusive-or FcConfigParseAndLoadFromMemory,
-- call FcConfigBuildFonts to build the font database.
parseAndLoad :: Config -> FilePath -> Bool -> IO ()
parseAndLoad conf path complain =
    throwBool =<< withForeignPtr conf (\conf' -> withCString path $ \path' ->
        fcConfigParseAndLoad conf' path' complain)
foreign import capi "fontconfig/fontconfig.h FcConfigParseAndLoad" fcConfigParseAndLoad ::
    Ptr Config' -> CString -> Bool -> IO Bool
-- | Walks the configuration in 'buf' and constructs the internal representation in 'conf'.
-- Any includes files referenced from within 'buf' will be loaded and dparsed.
-- If 'complain' is False, no warning will be displayed if 'file' does not exist.
-- Error and warning messages will be output to stderr.
-- Throws an exception if fsome error occurred while loading the file, either a parse error,
-- semantic error or allocation failure. After all configuration files or strings have been loaded,
-- with FcConfigParseAndLoad inclusive-or FcConfigParseAndLoadFromMemory,
-- call FcConfigBuildFonts to build the font database.
parseAndLoadFromMemory :: Config -> FilePath -> Bool -> IO ()
parseAndLoadFromMemory conf buf complain =
    throwBool =<< withForeignPtr conf (\conf' -> withCString buf $ \buf' ->
        fcConfigParseAndLoadFromMemory conf' buf' complain)
foreign import capi "fontconfig/fontconfig.h FcConfigParseAndLoadFromMemory"
    fcConfigParseAndLoadFromMemory :: Ptr Config' -> CString -> Bool -> IO Bool

-- | Obtains the system root directory in 'conf' if available.
-- All files (including file properties in patterns) obtained from this 'conf'
-- are relative to this system root directory.
sysroot :: Config -> IO String
sysroot conf = peekCString =<< withForeignPtr conf fcConfigGetSysRoot
-- FIXME: Upgrade GHC so I can use const pointers!
foreign import ccall "fontconfig/fontconfig.h FcConfigGetSysRoot" fcConfigGetSysRoot ::
    Ptr Config' -> IO CString

-- | Set 'root' as the system root directory. All file paths used or created with this 'conf'
-- (including file properties in patterns) will be considered or made relative to this 'root'.
-- This allows a host to generate caches for targets at build time.
-- This also allows a cache to be re-targeted to a different base directory if 'FcConfigGetSysRoot'
-- is used to resolve file paths. When setting this on the current config this causes
-- changing current config (calls FcConfigSetCurrent()).
setSysroot :: Config -> String -> IO ()
setSysroot conf root =
    withForeignPtr conf $ \conf' -> withCString root $ fcConfigSetSysRoot conf'
foreign import capi "fontconfig/fontconfig.h FcConfigSetSysRoot" fcConfigSetSysRoot ::
    Ptr Config' -> CString -> IO ()

-- TODO (maybe): FcConfigFileInfoIterInit, FcConfigFileInfoIterNext, & FcConfigFileInfoIterGet