{-# LANGUAGE CApiFFI #-}
module Graphics.Text.Font.Choose.LangSet(
        LangSet, LangSet'(..), module S, LangComparison(..),
        cmp, has, defaultLangs, langs, normalize, langCharSet) where

import Data.Set (Set)
import qualified Data.Set as S

import Data.MessagePack (MessagePack(..))
import Graphics.Text.Font.Choose.StrSet (StrSet)
import Graphics.Text.Font.Choose.CharSet (CharSet')

import Foreign.C.String (CString)
import Foreign.Ptr (Ptr)
import Graphics.Text.Font.Choose.Internal.FFI (withMessage, fromMessage0, withCString', peekCString')
import Graphics.Text.Font.Choose.Result
import Control.Exception (throw)

type LangSet = Set String
newtype LangSet' = LangSet' { unLangSet :: LangSet }

instance MessagePack LangSet' where
    toObject = toObject . S.toList . unLangSet
    fromObject msg = LangSet' <$> S.fromList <$> fromObject msg

data LangComparison = SameLang | SameTerritory | DifferentLang
i2cmp :: Int -> LangComparison
i2cmp 0 = DifferentLang
i2cmp 1 = SameLang
i2cmp 2 = SameTerritory
i2cmp _ = throw ErrOOM

cmp :: LangSet' -> LangSet' -> LangComparison
cmp a b = i2cmp $ withMessage fcLangSetCompare [a, b]

foreign import capi "fontconfig-wrap.h" fcLangSetCompare :: CString -> Int -> Int

has :: LangSet' -> String -> LangComparison
has a b = i2cmp $ flip withCString' b $ withMessage fcLangSetHasLang a

foreign import capi "fontconfig-wrap.h" fcLangSetHasLang :: CString -> Int -> CString -> Int

defaultLangs :: StrSet
defaultLangs = fromMessage0 fcGetDefaultLangs

foreign import capi "fontconfig-wrap.h" fcGetDefaultLangs :: Ptr Int -> CString

langs :: StrSet
langs = fromMessage0 fcGetLangs

foreign import capi "fontconfig-wrap.h" fcGetLangs :: Ptr Int -> CString

normalize :: String -> String
normalize = peekCString' . withCString' fcLangNormalize

foreign import capi "fontconfig-wrap.h" fcLangNormalize :: CString -> CString

langCharSet :: String -> CharSet'
langCharSet = fromMessage0 . withCString' fcLangGetCharSet

foreign import capi "fontconfig-wrap.h" fcLangGetCharSet :: CString -> Ptr Int -> CString