module Graphics.Text.Font.Choose.LangSet (LangSet, defaultLangs, langs,
    langSetCompare, langNormalize, langCharSet,
    LangSet_, withLangSet, thawLangSet) where

import Data.Set (Set)
import qualified Data.Set as Set
import Graphics.Text.Font.Choose.Strings (thawStrSet, thawStrSet_, StrSet_)
import Graphics.Text.Font.Choose.CharSet (thawCharSet, CharSet_, CharSet)
import Graphics.Text.Font.Choose.Result (throwNull, throwFalse)

import Foreign.Ptr (Ptr)
import Foreign.C.String (CString, withCString, peekCString)
import Foreign.Marshal.Alloc (free)
import Control.Exception (bracket)
import Control.Monad (forM)
import System.IO.Unsafe (unsafePerformIO)

type LangSet = Set String

defaultLangs :: IO LangSet
defaultLangs = thawStrSet =<< fcGetDefaultLangs
foreign import ccall "FcGetDefaultLangs" fcGetDefaultLangs :: IO StrSet_

langs :: LangSet
langs = unsafePerformIO $ thawStrSet_ $ fcGetLangs
foreign import ccall "FcGetLangs" fcGetLangs :: IO StrSet_

data LangResult = SameLang | DifferentTerritory | DifferentLang
    deriving (Enum, Eq, Read, Show)
langSetCompare :: LangSet -> LangSet -> LangResult
langSetCompare a b = unsafePerformIO $ withLangSet a $ \a' -> withLangSet b $ \b' ->
    (toEnum <$> fcLangSetCompare a' b')
foreign import ccall "FcLangSetCompare" fcLangSetCompare ::
    LangSet_ -> LangSet_ -> IO Int

langSetContains :: LangSet -> LangSet -> Bool
langSetContains a b = unsafePerformIO $ withLangSet a $ \a' -> withLangSet b $
    fcLangSetContains a'
foreign import ccall "FcLangSetContains" fcLangSetContains ::
    LangSet_ -> LangSet_ -> IO Bool

langSetHasLang :: LangSet -> String -> LangResult
langSetHasLang a b = unsafePerformIO $ withLangSet a $ \a' -> withCString b $ \b' ->
    (toEnum <$> fcLangSetHasLang a' b')
foreign import ccall "FcLangSetHasLang" fcLangSetHasLang :: LangSet_ -> CString -> IO Int

langNormalize :: String -> String
langNormalize "" = ""
langNormalize lang = unsafePerformIO $ withCString lang (peekCString_ . fcLangNormalize)
foreign import ccall "FcLangNormalize" fcLangNormalize :: CString -> CString
peekCString_ str' = do
    str <- peekCString $ throwNull str'
    free str'
    return str

langCharSet :: String -> CharSet
langCharSet lang = unsafePerformIO $
    withCString lang (thawCharSet . throwNull . fcLangGetCharSet)
foreign import ccall "FcLangGetCharSet" fcLangGetCharSet :: CString -> CharSet_

------
--- Low-level
------

data LangSet'
type LangSet_ = Ptr LangSet'

withNewLangSet :: (LangSet_ -> IO a) -> IO a
withNewLangSet = bracket (throwNull <$> fcLangSetCreate) fcLangSetDestroy
foreign import ccall "FcLangSetCreate" fcLangSetCreate :: IO LangSet_
foreign import ccall "FcLangSetDestroy" fcLangSetDestroy :: LangSet_ -> IO ()

withLangSet :: LangSet -> (LangSet_ -> IO a) -> IO a
withLangSet langs cb = withNewLangSet $ \langs' -> do
    forM (Set.elems langs) $ flip withCString $ \lang' ->
        throwFalse <$> fcLangSetAdd langs' lang'
    cb langs'
foreign import ccall "FcLangSetAdd" fcLangSetAdd :: LangSet_ -> CString -> IO Bool

thawLangSet :: LangSet_ -> IO LangSet
thawLangSet = thawStrSet_ . fcLangSetGetLangs
foreign import ccall "FcLangSetGetLangs" fcLangSetGetLangs :: LangSet_ -> IO StrSet_