{-# 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 as CS (CharSet'(..), empty)

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 validLang x && not (null x)
validLangSet' :: LangSet' -> Bool
validLangSet' = validLangSet . unLangSet
validLang :: String -> Bool
validLang = (`elem` unStrSet langs)

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 | valid a && valid b = i2cmp $ withMessage fcLangSetCompare [a, b]
    | otherwise = DifferentLang
  where valid = validLangSet'

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

has :: LangSet' -> String -> LangComparison
has a b | validLangSet' a && validLang b =
        i2cmp $ flip withCString' b $ withMessage fcLangSetHasLang a
    | otherwise = DifferentLang

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 a | validLang a = fromMessage0 $ withCString' fcLangGetCharSet a
    | otherwise = CharSet' CS.empty

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