{-# LANGUAGE CApiFFI #-}
module Graphics.Text.Font.Choose.Config.Accessors 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)
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 =<< fcConfigGetCurrent
foreign import capi "fontconfig/fontconfig.h FcConfigGetCurrent" fcConfigGetCurrent :: 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