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

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

import Data.MessagePack (MessagePack(..))
import Test.QuickCheck (Arbitrary(..), elements, listOf)
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 } deriving (Eq, Show, Read)

validLangSet :: LangSet -> Bool
validLangSet x = all (`elem` unStrSet langs) x && not (null x)
validLangSet' :: LangSet' -> Bool
validLangSet' = validLangSet . unLangSet

instance MessagePack LangSet' where
    toObject = toObject . S.toList . unLangSet
    fromObject msg = LangSet' <$> S.fromList <$> fromObject msg
instance Arbitrary LangSet' where
    arbitrary = LangSet' <$> S.fromList <$> listOf (elements $ S.toList $ unStrSet langs)

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