1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
{-# 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