{-# LANGUAGE OverloadedStrings #-} module Main (main) where import Test.Hspec import Test.Hspec.QuickCheck 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 qualified Data.IntSet as IS import Data.Maybe (isJust, fromMaybe) import GHC.Real (infinity) import Graphics.Text.Font.Choose import Graphics.Text.Font.Choose.Internal.Test main :: IO () main = hspec $ do describe "Canary" $ do it "runs fine" $ do True `shouldBe` True describe "Roundtrips" $ do describe "converts MessagePack & back" $ do prop "CharSet" $ \x -> MP.unpack (MP.pack x) `shouldBe` Just (x :: CharSet') prop "FontSet" $ \x -> let y = Prelude.map unPattern x in MP.unpack (MP.pack y) `shouldBe` Just y prop "LangSet" $ \x -> MP.unpack (MP.pack x) `shouldBe` Just (x :: LangSet') prop "ObjectSet" $ \x -> MP.unpack (MP.pack x) `shouldBe` Just (x :: ObjectSet) prop "Pattern" $ \x -> MP.unpack (MP.pack x) `shouldBe` Just (x :: Pattern') prop "Range" $ \x -> MP.unpack (MP.pack x) `shouldBe` Just (x :: Range) prop "StrSet" $ \x -> MP.unpack (MP.pack x) `shouldBe` Just (x :: StrSet) prop "Value" $ \x -> MP.unpack (MP.pack x) `shouldBe` Just (x :: Value) describe "through C datastructures" $ do prop "StrSet" $ \x -> validStrSet x ==> roundtrip testStrSet x `shouldBe` Just (x :: StrSet) prop "CharSet" $ \x -> validCharSet' x ==> roundtrip testCharSet x `shouldBe` Just (x :: CharSet') prop "LangSet" $ \x -> validLangSet' x ==> roundtrip testLangSet x `shouldBe` Just (x :: LangSet') prop "Range" $ \x -> validRange x ==> roundtrip testRange x `shouldBe` Just (x :: Range) prop "Matrix" $ \x -> roundtrip testMatrix x `shouldBe` Just (x :: (Double, Double, Double, Double)) prop "Value" $ \x -> validValue x ==> roundtrip testValue x `shouldBe` Just (x :: Value) prop "Trivial Pattern" $ \x -> validValue x ==> let pat = Pattern' $ M.fromList [("test", [(Strong, x)])] in roundtrip testPattern pat `shouldBe` Just pat prop "Tuple Pattern" $ \(x, y) -> validValue x && validValue y ==> let pat = Pattern' $ M.fromList [("a", [(Strong, x)]), ("b", [(Strong, y)])] in roundtrip testPattern pat `shouldBe` Just pat let toAscii :: Char -> Char toAscii ch = toEnum $ fromEnum ch `mod` 128 prop "Random-key pattern" $ \x -> all (\y -> toAscii y /= '\0') x ==> let pat = Pattern' $ M.fromList [(Txt.pack $ map toAscii $ take 17 x, [(Strong, ValueBool True)])] in roundtrip testPattern pat `shouldBe` Just pat prop "Pattern" $ \x -> validPattern' x ==> 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 it "Font weights" $ do weightFromOpenTypeDouble (fromRational infinity) `shouldBe` 215 weightFromOpenType maxBound `shouldBe` 215 it "Name parsing" $ do nameParse "sans\\-serif" `shouldBe` M.fromList [ ("family", [(Strong, ValueString "sans-serif")]) ] nameParse "Foo-10" `shouldBe` M.fromList [ ("family", [(Strong, ValueString "Foo")]), -- NOTE: Equality derived from the pure-Haskell type is stricter than FontConfig's. -- This subtest might fail in the future, not sure what to do about that. ("size", [(Strong, ValueDouble 10)]) ] nameParse "Foo,Bar-10" `shouldBe` M.fromList [ ("family", [(Strong, ValueString "Foo"), (Strong, ValueString "Bar")]), ("size", [(Strong, ValueDouble 10)]) ] nameParse "Foo:weight=medium" `shouldBe` M.fromList [ ("family", [(Strong, ValueString "Foo")]), ("weight", [(Strong, ValueDouble 100)]) ] nameParse "Foo:weight_medium" `shouldBe` M.fromList [ ("family", [(Strong, ValueString "Foo")]), ("weight", [(Strong, ValueDouble 100)]) ] nameParse ":medium" `shouldBe` M.fromList [ ("weight", [(Strong, ValueInt 100)]) ] nameParse ":normal" `shouldBe` M.fromList [ ("width", [(Strong, ValueInt 100)]) ] nameParse ":weight=[medium bold]" `shouldBe` M.fromList [ ("weight", [(Strong, ValueRange $ Range 100 200)]) ] describe "CSS Parsing" $ do it "unicode-range" $ do let parseCharSet' = IS.toList . fromMaybe IS.empty . parseCharSet parseCharSet' "U+26" `shouldBe` [0x26] parseCharSet' "U+26, U+42" `shouldBe` [0x26, 0x42] parseCharSet' "U+0-7F" `shouldBe` [0x0..0x7f] parseCharSet' "U+0025-00FF" `shouldBe` [0x0025..0x00ff] parseCharSet' "U+4??" `shouldBe` [0x400..0x4ff] parseCharSet' "U+0025-00FF, U+4??" `shouldBe` [0x0025..0x00ff] ++ [0x400..0x4ff]