~alcinnz/fontconfig-pure

ref: c406e2016b6ae9b909501c05c5790693092447e3 fontconfig-pure/lib/Graphics/Text/Font/Choose/LangSet.hs -rw-r--r-- 2.1 KiB
c406e201 — Adrian Cochrane Properly handle ambiguity in empty char/lang sets. 7 months ago
                                                                                
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
60
61
62
63
64
{-# LANGUAGE CApiFFI #-}
module Graphics.Text.Font.Choose.LangSet(
        LangSet, LangSet'(..), module S, LangComparison(..),
        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(..))
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)

instance MessagePack LangSet' where
    toObject = toObject . S.toList . unLangSet
    fromObject msg = LangSet' <$> S.fromList <$> fromObject msg
instance Arbitrary LangSet' where
    arbitrary = LangSet' <$> arbitrary

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