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

import Data.Set as S hiding (valid)

import Data.Hashable (Hashable(..))
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)

-- | A set of language names (each of which include language and an optional territory).
-- They are used when selecting fonts to indicate which languages the fonts need to support.
-- Each font is marked, using language orthography information built into fontconfig,
-- with the set of supported languages.
type LangSet = Set String
-- | Wrapper around LangSet adding useful typeclasses
newtype LangSet' = LangSet' { unLangSet :: LangSet } deriving (Eq, Show, Read)

instance Hashable LangSet' where
    hashWithSalt salt (LangSet' self) = hashWithSalt salt self

-- | Can the given LangSet be processed by FontConfig?
validLangSet :: LangSet -> Bool
validLangSet x = all validLang x && not (Prelude.null x)
-- | Can the given LangSet' be processed by FontConfig?
validLangSet' :: LangSet' -> Bool
validLangSet' = validLangSet . unLangSet
-- | Can the given language code be processed by FontConfig?
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)

-- | The result of `cmp`.
data LangComparison = DifferentLang -- ^ The locales share no languages in common
    | SameLang -- ^ The locales share any language and territory pair
    | DifferentTerritory -- ^ The locales share a language but differ in which territory that language is for
    deriving (Read, Show, Eq, Enum, Bounded)
i2cmp :: Int -> LangComparison
i2cmp 0 = DifferentLang
i2cmp 1 = SameLang
i2cmp 2 = DifferentTerritory
i2cmp _ = throw ErrOOM

-- | Compares language coverage for the 2 given LangSets.
cmp' :: LangSet' -> LangSet' -> LangComparison
cmp' a b | valid a && valid b = i2cmp $ withMessage fcLangSetCompare [a, b]
    | otherwise = DifferentLang
  where valid = validLangSet'
cmp :: LangSet -> LangSet -> LangComparison
cmp a b = LangSet' a `cmp'` LangSet' b

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

-- | returns True if `a` contains every language in `b`.
-- `a`` will contain a language from `b` if `a` has exactly the language,
-- or either the language or `a` has no territory.
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

-- | Returns a string set of the default languages according to the environment variables on the system.
-- This function looks for them in order of FC_LANG, LC_ALL, LC_CTYPE and LANG then.
-- If there are no valid values in those environment variables, "en" will be set as fallback.
defaultLangs :: StrSet
defaultLangs = fromMessage0 fcGetDefaultLangs

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

-- | Returns a string set of all languages.
langs :: StrSet
langs = fromMessage0 fcGetLangs

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

-- | Returns a string to make lang suitable on fontconfig.
normalize :: String -> String
normalize = peekCString' . withCString' fcLangNormalize

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

-- | Returns the CharSet for a language.
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