{-# LANGUAGE CApiFFI #-}
module Graphics.Text.Font.Choose.Config.Accessors(
        configCreate, setCurrent, current, uptodate, home, enableHome, buildFonts,
        configDirs, fontDirs, configFiles, cacheDirs, fonts, rescanInterval,
        setRescanInterval, appFontAddFile, appFontAddDir, appFontClear, substituteWithPat,
        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)

configCreate :: IO Config
configCreate = newForeignPtr fcConfigDestroy =<< throwNull =<< fcConfigCreate
foreign import capi "fontconfig/fontconfig.h FcConfigCreate" fcConfigCreate :: IO (Ptr Config')

setCurrent :: Config -> IO ()
setCurrent conf = throwBool =<< withForeignPtr conf fcConfigSetCurrent
foreign import capi "fontconfig/fontconfig.h FcConfigSetCurrent" fcConfigSetCurrent :: Ptr Config' -> IO Bool

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

uptodate :: Config -> IO Bool
uptodate conf = withForeignPtr conf fcConfigUptoDate
foreign import capi "fontconfig/fontconfig.h FcConfigUptoDate" fcConfigUptoDate :: Ptr Config' -> IO Bool

home :: String
home = peekCString' fcConfigHome
foreign import capi "fontconfig/fontconfig.h FcConfigHome" fcConfigHome :: CString

foreign import capi "fontconfig/fontconfig.h FcConfigEnableHome" enableHome :: Bool -> IO Bool

buildFonts :: Config -> IO ()
buildFonts conf = throwBool =<< withForeignPtr conf fcConfigBuildFonts
foreign import capi "fontconfig/fontconfig.h FcConfigBuildFonts" fcConfigBuildFonts :: Ptr Config' -> IO Bool

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

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

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

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

data SetName = System | App deriving Eq
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

rescanInterval :: Config -> IO Int
rescanInterval = flip withForeignPtr fcConfigGetRescanInterval
foreign import capi "fontconfig/fontconfig.h FcConfigGetRescanInterval" fcConfigGetRescanInterval ::
        Ptr Config' -> IO Int

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

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

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

appFontClear :: Config -> IO ()
appFontClear = flip withForeignPtr fcConfigAppFontClear
foreign import capi "fontconfig/fontconfig.h FcConfigAppFontClear" fcConfigAppFontClear ::
        Ptr Config' -> IO ()

data MatchKind = MatchPattern | MatchFont deriving Eq
substituteWithPat :: Config -> Pattern -> Maybe Pattern -> MatchKind -> Pattern
substituteWithPat conf p (Just p_pat) kind =
    fromMessage0 $ flip withForeignPtr' conf $ \conf' -> flip withMessage [p, p_pat] $ \msg len -> 
        fcConfigSubstituteWithPat conf' msg len (kind == MatchFont)
substituteWithPat 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

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

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

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

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

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...

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

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

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