{-# LANGUAGE CApiFFI #-} module Graphics.Text.Font.Choose.LangSet 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