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 Graphics.Text.Font.Choose.Result (throwNull, throwFalse)

import Foreign.ForeignPtr
import Foreign.Ptr (Ptr, nullPtr, FunPtr)
import Foreign.Marshal.Alloc (alloca, allocaBytes)
import Foreign.Storable (Storable(..))
import Foreign.C.String (CString, peekCString, withCString)
import System.IO.Unsafe (unsafePerformIO)

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

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

configSetCurrent :: Config -> IO ()
configSetCurrent config = throwFalse =<< (withForeignPtr config $ fcConfigSetCurrent)
foreign import ccall "FcConfigSetCurrent" fcConfigSetCurrent :: Config_ -> IO Bool

configGetCurrent :: IO Config
configGetCurrent = (throwNull <$> fcConfigReference nullPtr) >>=
    newForeignPtr fcConfigDestroy
foreign import ccall "FcConfigReference" fcConfigReference :: Config_ -> 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

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

configBuildFonts :: Config -> IO ()
configBuildFonts config = throwFalse =<< (withForeignPtr config $ fcConfigBuildFonts)
configBuildFonts' :: IO ()
configBuildFonts' = throwFalse =<< fcConfigBuildFonts nullPtr
foreign import ccall "FcConfigBuildFonts" 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, Eq, Show, Read)
configGetFonts :: Config -> SetName -> IO FontSet
configGetFonts config set = do
    ret <- withForeignPtr config $ flip fcConfigGetFonts $ fromEnum set
    thawFontSet $ throwNull ret
configGetFonts' :: SetName -> IO FontSet
configGetFonts' set = do
    ret <- fcConfigGetFonts nullPtr $ fromEnum set
    thawFontSet $ throwNull ret
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 ()
configSetRescanInterval config val =
    throwFalse =<< (withForeignPtr config $ flip fcConfigSetRescanInterval val)
configSetRescanInterval' :: Int -> IO ()
configSetRescanInterval' v = throwFalse =<< fcConfigSetRescanInterval nullPtr v
foreign import ccall "FcConfigSetRescanInterval" fcConfigSetRescanInterval ::
    Config_ -> Int -> IO Bool

configAppFontAddFile :: Config -> String -> IO ()
configAppFontAddFile config file = throwFalse =<<
    (withForeignPtr config $ \config' -> withCString file $ \file' ->
        fcConfigAppFontAddFile config' file')
configAppFontAddFile' :: String -> IO ()
configAppFontAddFile' file =
    throwFalse =<< (withCString file $ 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
configSubstitute' 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 <$> thawFontSet ret else return Nothing
fontSort' :: Pattern -> Bool -> CharSet -> Maybe FontSet
fontSort' pattern trim csp = unsafePerformIO $ withPattern pattern $ \pattern' ->
    withCharSet csp $ \csp' -> alloca $ \res' -> do
        ret <- fcFontSort nullPtr pattern' trim csp' res'
        res <- peek res'
        if res == 0 then Just <$> thawFontSet ret else return Nothing
foreign import ccall "FcFontSort" fcFontSort ::
    Config_ -> Pattern_ -> Bool -> CharSet_ -> Ptr Int -> IO FontSet_

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 <- fcFontList config' p' os'
        thawFontSet ret
fontList' :: Pattern -> ObjectSet -> FontSet
fontList' p os = unsafePerformIO $ withPattern p $ \p' -> withObjectSet os $ \os' -> do
    ret <- fcFontList 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' -> do
    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' -> allocaBytes configFileInfoIter'Size $ \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'
foreign import ccall "size_ConfigFileInfoIter" configFileInfoIter'Size :: Int
type ConfigFileInfoIter_ = Ptr ConfigFileInfoIter'
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 = thawStrList_ $ withForeignPtr config cb