module Graphics.Text.Font.Choose.Config where

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

import Foreign.ForeignPtr
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.C.String (CString, peekCString)
import System.IO.Unsafe (unsafePerformIO)

type Config = ForeignPtr Config'
data Config'
type Config_ = Ptr Config'

configCreate :: IO Config
configCreate = newForeignPtr fcConfigDestroy =<< fcConfigCreate
foreign import ccall "FcConfigCreate" fcConfigCreate :: IO Config_
foreign import ccall "FcConfigDestroy" fcConfigDestroy :: Config_ -> IO ()

configGetCurrent :: IO Config
configGetCurrent = newForeignPtr_ =<< fcConfigGetCurrent
foreign import ccall "FcConfigGetCurrent" fcConfigGetCurrent :: IO Config_

configUptoDate :: Config -> IO Bool
configUptoDate config = withForeignPtr config $ fcConfigUptoDate
foreign import ccall "FcConfigUptoDate" fcConfigUptoDate :: Config_ -> IO Bool

configHome :: IO (Maybe String)
configHome = do
    ret <- fcConfigHome
    if ret == nullPtr then return Nothing else Just <$> peekCString ret
foreign import ccall "FcConfigHome" fcConfigHome :: IO CString

configEnableHome :: Bool -> IO Bool
foreign import ccall "FcConfigEnableHome" configEnableHome :: Bool -> IO Bool

configBuildFonts :: Config -> IO Bool
configBuildFonts config = withForeignPtr config $ fcConfigBuildFonts
configBuildFonts' :: IO Bool
configBuildFonts' = fcConfigBuildFonts nullPtr
foreign import ccall "FcConfigBuildFonts" :: Config_ -> IO Bool

configGetConfigDirs :: Config -> IO StrList
configGetConfigDirs = configStrsFunc fcConfigGetConfigDirs
configGetConfigDirs' :: IO StrList
configGetConfigDirs' = thawStrList =<< fcConfigGetConfigDirs nullPtr
foreign import ccall "FcConfigGetConfigDirs" fcConfigGetConfigDirs :: Config_ -> IO StrList_

configGetFontDirs :: Config -> IO StrList
configGetFontDirs = configStrsFunc fcConfigGetFontDirs
configGetFontDirs' :: IO StrList
configGetFontDirs' = thawStrList =<< fcConfigGetFontDirs nullPtr
foreign import ccall "FcConfigGetFontDirs" fcConfigGetFontDirs :: Config_ -> IO StrList_

configGetConfigFiles :: Config -> IO StrList
configGetConfigFiles = configStrsFunc fcConfigGetConfigFiles
configGetConfigFiles' :: IO StrList
configGetConfigFiles' = thawStrList =<< fcConfigGetConfigFiles nullPtr
foreign import ccall "FcConfigGetConfigFiles" fcConfigGetConfigFiles :: Config_ -> IO StrList_

configGetCacheDirs :: Config -> IO StrList
configGetCacheDirs = configStrsFunc fcConfigGetCacheDirs
configGetCacheDirs' :: IO StrList
configGetCacheDirs' = thawStrList =<< fcConfigGetCacheDirs nullPtr
foreign import ccall "FcConfigGetCacheDirs" fcConfigGetCacheDirs :: Config_ -> IO StrList_

data SetName = SetSystem | SetApplication deriving (Enum)
configGetFonts :: Config -> SetName -> IO FontSet
configGetFonts config set = do
    ret <- withForeignPtr config $ flip fcConfigGetFonts $ fromEnum set
    thawFontSet ret
configGetFonts' :: SetName -> IO FontSet
configGetFonts' set = thawFontSet =<< fcConfigGetFonts nullPtr $ fromEnum set
foreign import ccall "FcConfigGetFonts" fcConfigGetFonts -> Config_ -> Int -> IO FontSet_

configGetRescanInterval :: Config -> IO Int
configGetRescanInterval = flip withForeignPtr $ fcConfigGetRescanInterval
configGetRescanInterval' :: IO Int
configGetRescanInterval' = fcConfigGetRescanInterval nullPtr
foreign import ccall "FcConfigGetRescanInterval" fcConfigGetRescanInterval ::
    Config_ -> IO Int

configSetRescanInterval :: Config -> Int -> IO Bool
configSetRescanInterval config val =
    withForeignPtr config $ flip fcConfigSetRescanInterval val
configSetRescanInterval' :: Int -> IO Bool
configSetRescanInterval' = fcConfigSetRescanInterval nullPtr
foreign import ccall "FcConfigSetRescanInterval" fcConfigSetRescanInterval ::
    Config_ -> Int -> IO Bool

configAppFontAddFile :: Config -> String -> IO Bool
configAppFontAddFile config file =
    withForeignPtr config $ \config' -> withCString file $ \file' ->
        fcConfigAppFontAddFile config' file'
configAppFontAddFile' :: String -> IO Bool
configAppFontAddFile' = flip withCString $ fcConfigAppFontAddFile nullPtr
foreign import ccall "FcConfigAppFontAddFile" fcConfigAppFontAddFile ::
    Config_ -> CString -> IO Bool

configAppFontAddDir :: Config -> String -> IO Bool
configAppFontAddDir config file =
    withForeignPtr config $ \config' -> withCString file $ fcConfigAppFontAddDir config'
configAppFontAddDir' :: String -> IO Bool
configAppFontAddDir' = flip withCString $ fcConfigAppFontAddDir nullPtr
foreign import ccall "FcConfigAppFontAddDir" fcConfigAppFontAddDir ::
    Config_ -> CString -> IO Bool

configAppFontClear :: Config -> IO Bool
configAppFontClear = flip withForeignPtr fcConfigAppFontClear
configAppFontClear' :: IO Bool
configAppFontClear' = fcConfigAppFontClear nullPtr
foreign import ccall "FcConfigAppFontClear" fcConfigAppFontClear :: Config_ -> IO Bool

data MatchKind = MatchPattern | MatchFont | MatchScan deriving Enum
configSubstituteWithPat :: Config -> Pattern -> Pattern -> MatchKind -> Maybe Pattern
configSubstituteWithPat config p p_pat kind = unsafePerformIO $
    withForeignPtr config $ \config' -> withPattern p $ \p' ->
        withPattern p_pat $ \p_pat' -> do
            ok <- fcConfigSubstituteWithPat config' p' p_pat' $ fromEnum kind
            if ok then Just <$> thawPattern p' else return Nothing
configSubstituteWithPat' :: Pattern -> Pattern -> MatchKind -> Maybe Pattern
configSubstituteWithPat' p p_pat kind = unsafePerformIO $
    withPattern p $ \p' -> withPattern p_pat $ \p_pat' -> do
        ok <- fcConfigSubstituteWithPat nullPtr p' p_pat' $ fromEnum kind
        if ok then Just <$> thawPattern p' else return Nothing
foreign import ccall "FcConfigSubstituteWithPat" fcConfigSubstituteWithPat ::
    Config_ -> Pattern_ -> Pattern_ -> Int -> IO Bool

configSubstitute :: Config -> Pattern -> MatchKind -> Maybe Pattern
configSubstitute config p kind = unsafePerformIO $
    withForeignPtr config $ \config' -> withPattern p $ \p' -> do
        ok <- fcConfigSubstitute config' p' $ fromEnum kind
        if ok then Just <$> thawPattern p' else return Nothing
configSubstitute' :: Pattern -> MatchKind -> Maybe Pattern
configSubsitute' p kind = unsafePerformIO $ withPattern p $ \p' -> do
    ok <- fcConfigSubstitute nullPtr p' $ fromEnum kind
    if ok then Just <$> thawPattern p' else return Nothing
foreign import ccall "FcConfigSubstitute" fcConfigSubstitute ::
    Config_ -> Pattern_ -> Int -> IO Bool

fontMatch :: Config -> Pattern -> Maybe Pattern
fontMatch config pattern = unsafePerformIO $ withForeignPtr config $ \config' ->
    withPattern pattern $ \pattern' -> alloca $ \res' -> do
        ret <- fcFontMatch config' pattern' res'
        res <- peek res'
        if res == 0 then Just <$> thawPattern ret else return Nothing
fontMatch' :: Pattern -> Maybe Pattern
fontMatch' pattern = unsafePerformIO $ withPattern pattern $ \pattern' -> alloca $ \res' -> do
    ret <- fcFontMatch nullPtr pattern' res'
    res <- peek res'
    if res == 0 then Just <$> thawPattern ret else return Nothing
foreign import ccall "FcFontMatch" fcFontMatch :: Config_ -> Pattern_ -> Ptr Int -> IO Pattern_

fontSort :: Config -> Pattern -> Bool -> CharSet -> Maybe FontSet
fontSort config pattern trim csp = unsafePerformIO $ withForeignPtr config $ \config' ->
    withPattern pattern $ \pattern' -> withCharSet csp $ \csp' -> alloca $ \res' -> do
        ret <- fcFontSort config' pattern' trim csp' res'
        res <- peek res'
        if res == 0 then Just <$> thawPattern ret else return Nothing
fontSort' :: Pattern -> Bool -> CharSet -> Maybe FontSet
fontSort' pattern trim csp = unsafePerformIO $ withPattern $ \pattern' ->
    withCharSet csp $ \csp' -> alloca $ \res' -> do
        ret <- fcFontSort nullPtr pattern' trim csp' res'
        res <- peek res'
        if res == 0 then Just <$> thawPattern ret else return Nothing
foreign import ccall "FcFontSort" fcFontSort ::
    Config_ -> Pattern_ -> Bool -> CharSet_ -> Ptr Int -> IO Pattern_

fontRenderPrepare :: Config -> Pattern -> Pattern -> Pattern
fontRenderPrepare config pat font = unsafePerformIO $ withForeignPtr config $ \config' ->
    withPattern pat $ \pat' -> withPattern font $ \font' -> do
        ret <- fcFontRenderPrepare config' pat' font'
        thawPattern ret
fontRenderPrepare' :: Pattern -> Pattern -> Pattern
fontRenderPrepare' pat font = unsafePerformIO $ withPattern pat $ \pat' ->
    withPattern font $ \font' -> do
        ret <- fcFontRenderPrepare nullPtr pat' font'
        thawPattern ret
foreign import ccall "FcFontRenderPrepare" fcFontRenderPrepare ::
    Config_ -> Pattern_ -> Pattern_ -> IO Pattern_

fontList :: Config -> Pattern -> ObjectSet -> FontSet
fontList config p os = unsafePerformIO $ withForeignPtr config $ \config' ->
    withPattern p $ \p' -> withObjectSet os $ \os' -> do
        ret <- fontList config' p' os'
        thawFontSet ret
fontList' :: Pattern -> ObjectSet -> FontSet
fontList' p os = unsafePerformIO $ withPattern p $ \p' -> withObjectSet os $ \os' -> do
    ret <- fontList nullPtr p' os'
    thawFontSet ret
foreign import ccall "FcFontList" fcFontList :: Config_ -> Pattern_ -> ObjectSet_ -> IO FontSet_

configGetFilename :: Config -> String -> String
configGetFilename config name = unsafePerformIO $ withForeignPtr config $ \config' ->
    withCString name $ \name' -> do
        ret <- fcConfigGetFilename config' name'
        peekCString ret
configGetFilename' :: String -> String
configGetFilename' name = unsafePerformIO $ withCString name $ \name' ->
    ret <- fcConfigGetFilename nullPtr name'
    peekCString ret
foreign import ccall "FcConfigGetFilename" fcConfigGetFilename :: Config_ -> CString -> IO CString

configParseAndLoad :: Config -> String -> Bool -> IO Bool
configParseAndLoad config name complain = withForeignPtr config $ \config' ->
    withCString name $ \name' -> fcConfigParseAndLoad config' name' complain
configParseAndLoad' :: String -> Bool -> IO Bool
configParseAndLoad' name complain =
    withCString name $ \name' -> fcConfigParseAndLoad nullPtr name' complain
foreign import ccall "FcConfigParseAndLoad" fcConfigParseAndLoad ::
    Config_ -> CString -> Bool -> IO Bool

configParseAndLoadFromMemory :: Config -> String -> Bool -> IO Bool
configParseAndLoadFromMemory config buffer complain = withForeignPtr config $ \config' ->
    withCString buffer $ \buffer' ->
        fcConfigParseAndLoadFromMemory config' buffer' complain
configParseAndLoadFromMemory' :: String -> Bool -> IO Bool
configParseAndLoadFromMemory' buffer complain = withCString buffer $ \buffer' -=>
    fcConfigParseAndLoadFromMemory nullPtr buffer' complain
foreign import ccall "FcConfigParseAndLoadFromMemory" fcConfigParseAndLoadFromMemory ::
    Config_ -> CString -> Bool -> IO Bool

configGetSysRoot :: Config -> IO String
configGetSysRoot = flip withForeignPtr $ \config' -> do
    ret <- fcConfigGetSysRoot config'
    peekCString ret
configGetSysRoot' :: IO String
configGetSysRoot' = peekCString =<< fcConfigGetSysRoot nullPtr
foreign import ccall "FcConfigGetSysRoot" fcConfigGetSysRoot :: Config_ -> IO CString

configSetSysRoot :: Config -> String -> IO ()
configSetSysRoot config val = withForeignPtr config $ \config' -> withCString val $
    fcConfigSetSysRoot config'
configSetSysRoot' :: String -> IO ()
configSetSysRoot' val = withCString val $ fcConfigSetSysRoot nullPtr
foreign import ccall "FcConfigSetSysRoot" fcConfigSetSysRoot :: Config_ -> CString -> IO ()

configGetFileInfo :: Config -> IO [(FilePath, String, Bool)]
configGetFileInfo config = withForeignPtr config $ \config' -> alloca $ \iter' -> do
    fcConfigFileInfoIterInit config' iter'
    let readEnt = alloca $ \name' -> alloca $ \description' -> alloca $ \enabled' -> do
        ok <- fcConfigFileInfoIterGet config' iter' name' description' enabled'
        if ok then do
            name <- peekCString =<< peek name'
            description <- peekCString =<< peek description'
            enabled <- peek enabled'
            return $ Just (name, description, enabled)
        else return Nothing
    let go = do
        ent' <- readEnt
        case ent' of
            Just ent -> do
                ok <- fcConfigFileInfoIterNext config' iter'
                ents <- if ok then go else return []
                return (ent : ents)
            Nothing -> return []
    go
data ConfigFileInfoIter'
type ConfigFileInfoIter_ = Ptr ConfigFileInfo'
foreign import ccall "FcConfigFileInfoIterInit" fcConfigFileInfoIterInit ::
    Config_ -> ConfigFileInfoIter_ -> IO ()
foreign import ccall "FcConfigFileInfoIterNext" fcConfigFileInfoIterNext ::
    Config_ -> ConfigFileInfoIter_ -> IO Bool
foreign import ccall "FcConfigFileInfoIterGet" fcConfigFileInfoIterGet ::
    Config_ -> ConfigFileInfoIter_ -> Ptr CString -> Ptr CString -> Ptr Bool -> IO Bool

------

configStrsFunc :: (Config_ -> IO StrList_) -> Config -> IO StrList
configStrsFunc cb config = do
    ret <- withForeignPtr config cb
    thawStrList ret