3 files changed, 45 insertions(+), 11 deletions(-)

M lib/Graphics/Text/Font/Choose.hs
M lib/Graphics/Text/Font/Choose/LangSet.hs
M test/Main.hs

@@ 4,7 4,8 @@ module Graphics.Text.Font.Choose(
         initLoadConfig, initLoadConfigAndFonts, initFonts, reinit, bringUptoDate,
         CharSet, ord, chr, parseCharSet, CharSet'(..), validCharSet',
         module Graphics.Text.Font.Choose.FontSet,
-        module Graphics.Text.Font.Choose.LangSet,
+        LangSet, LangSet'(..), LangComparison(..), validLangSet, validLangSet',
+        cmp, cmp', has, defaultLangs, langs, normalize, langCharSet,
         module Graphics.Text.Font.Choose.ObjectSet,
         Pattern, Pattern'(..), Binding(..), validPattern, validPattern',
         setValue, setValues, getValue, getValues, equalSubset, defaultSubstitute,

@@ 2,10 2,9 @@
 -- | Languages supported by different fonts.
 module Graphics.Text.Font.Choose.LangSet(
         LangSet, LangSet'(..), module S, LangComparison(..), validLangSet, validLangSet',
-        cmp, has, defaultLangs, langs, normalize, langCharSet) where
+        cmp, cmp', has, defaultLangs, langs, normalize, langCharSet) where
 
-import Data.Set (Set)
-import qualified Data.Set as S
+import Data.Set as S hiding (valid)
 
 import Data.Hashable (Hashable(..))
 import Data.MessagePack (MessagePack(..))


@@ 32,7 31,7 @@ instance Hashable LangSet' where
 
 -- | Can the given LangSet be processed by FontConfig?
 validLangSet :: LangSet -> Bool
-validLangSet x = all validLang x && not (null x)
+validLangSet x = all validLang x && not (Prelude.null x)
 -- | Can the given LangSet' be processed by FontConfig?
 validLangSet' :: LangSet' -> Bool
 validLangSet' = validLangSet . unLangSet


@@ 47,21 46,23 @@ instance Arbitrary LangSet' where
     arbitrary = LangSet' <$> S.fromList <$> listOf (elements $ S.toList $ unStrSet langs)
 
 -- | The result of `cmp`.
-data LangComparison = SameLang -- ^ The locales share any language and territory pair
-    | SameTerritory -- ^ The locales share a language but differ in which territory that language is for
-    | DifferentLang -- ^ The locales share no languages in common
+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 = SameTerritory
+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]
+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
 

@@ 8,7 8,9 @@ import Test.QuickCheck
 
 import Data.MessagePack as MP
 import qualified Data.Map as M
+import qualified Data.Set as S
 import qualified Data.Text as Txt
+import Data.Maybe (isJust)
 
 import Graphics.Text.Font.Choose
 import Graphics.Text.Font.Choose.Internal.Test


@@ 64,3 66,33 @@ main = hspec $ do
                 roundtrip testPattern x `shouldBe` Just (x :: Pattern')
             prop "FontSet" $ \x -> let y = filter validPattern $ Prelude.map unPattern x
                 in validFontSet y ==> roundtrip testFontSet y `shouldBe` Just y
+    describe "FontConfig Testsuite transliteration" $ do
+        it "All system fonts should have files" $ do
+            conf <- current
+            res <- fonts conf System
+            let files = getValue "file" `map` res :: [Maybe String]
+            all isJust files `shouldBe` True
+        it "Locale compare" $ do
+            S.singleton "ku-am" `cmp` S.singleton "ku-iq" `shouldBe` DifferentTerritory
+            S.singleton "ku-am" `cmp` S.singleton "ku-ir" `shouldBe` DifferentTerritory
+            S.singleton "ku-am" `cmp` S.singleton "ku-tr" `shouldBe` DifferentTerritory
+            S.singleton "ku-iq" `cmp` S.singleton "ku-ir" `shouldBe` DifferentTerritory
+            S.singleton "ku-iq" `cmp` S.singleton "ku-tr" `shouldBe` DifferentTerritory
+            S.singleton "ku-ir" `cmp` S.singleton "ku-tr" `shouldBe` DifferentTerritory
+            S.singleton "ps-af" `cmp` S.singleton "ps-pk" `shouldBe` DifferentTerritory
+            S.singleton "ti-er" `cmp` S.singleton "ti-et" `shouldBe` DifferentTerritory
+            S.singleton "zh-cn" `cmp` S.singleton "zh-hk" `shouldBe` DifferentTerritory
+            S.singleton "zh-cn" `cmp` S.singleton "zh-mo" `shouldBe` DifferentTerritory
+            S.singleton "zh-cn" `cmp` S.singleton "zh-sg" `shouldBe` DifferentTerritory
+            S.singleton "zh-cn" `cmp` S.singleton "zh-tw" `shouldBe` DifferentTerritory
+            S.singleton "zh-hk" `cmp` S.singleton "zh-mo" `shouldBe` DifferentTerritory
+            S.singleton "zh-hk" `cmp` S.singleton "zh-sg" `shouldBe` DifferentTerritory
+            S.singleton "zh-hk" `cmp` S.singleton "zh-tw" `shouldBe` DifferentTerritory
+            S.singleton "zh-mo" `cmp` S.singleton "zh-sg" `shouldBe` DifferentTerritory
+            S.singleton "zh-mo" `cmp` S.singleton "zh-tw" `shouldBe` DifferentTerritory
+            S.singleton "zh-sg" `cmp` S.singleton "zh-tw" `shouldBe` DifferentTerritory
+            S.singleton "mn-mn" `cmp` S.singleton "mn-cn" `shouldBe` DifferentTerritory
+            S.singleton "pap-an" `cmp` S.singleton "pap-aw" `shouldBe` DifferentTerritory
+            -- A couple additional ones so we know its not always responding with DifferentTerritory!
+            S.singleton "mn-mn" `cmp` S.singleton "mn-mn" `shouldBe` SameLang
+            S.singleton "mn-mn" `cmp` S.singleton "pap-an" `shouldBe` DifferentLang