{-# 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 import qualified Graphics.Text.Font.Choose.Pattern as Pat import Data.CSS.Syntax.Tokens (Token(..), NumericValue(NVInteger), tokenize) import Stylist (PropertyParser(..)) import qualified Stylist.Parse as CSS 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 -- Taking test cases from MDN! 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] it "font-stretch" $ do let parseFontStretch' = Pat.parseFontStretch . Ident let parseFontStretch_ = Pat.parseFontStretch . Percentage "" . NVInteger parseFontStretch' "condensed" `shouldBe` Just 75 parseFontStretch' "expanded" `shouldBe` Just 125 parseFontStretch' "ultra-expanded" `shouldBe` Just 200 parseFontStretch_ 50 `shouldBe` Just 50 parseFontStretch_ 100 `shouldBe` Just 100 parseFontStretch_ 150 `shouldBe` Just 150 it "font-weight" $ do let parseFontWeight' = Pat.parseFontWeight . Ident let parseFontWeight_ = Pat.parseFontWeight . Number "" . NVInteger parseFontWeight' "normal" `shouldBe` Just 80 parseFontWeight' "bold" `shouldBe` Just 200 parseFontWeight_ 100 `shouldBe` Just 0 parseFontWeight_ 900 `shouldBe` Just 210 it "font-feature-settings" $ do Pat.parseFontFeatures [String "liga", Number "0" $ NVInteger 0] `shouldBe` ([ ("liga", 0) ], True, []) Pat.parseFontFeatures [String "tnum"] `shouldBe` ([ ("tnum", 1) ], True, []) Pat.parseFontFeatures [String "tnum"] `shouldBe` ([ ("tnum", 1) ], True, []) Pat.parseFontFeatures [String "scmp", Comma, String "zero"] `shouldBe` ([ ("scmp", 1), ("zero", 1) ], True, []) it "font-variation-settings" $ do Pat.parseFontVars [String "wght", Number "50" $ NVInteger 50] `shouldBe` ([ ("wght", 50) ], True, []) Pat.parseFontVars [String "wght", Number "850" $ NVInteger 850] `shouldBe` ([ ("wght", 850) ], True, []) Pat.parseFontVars [String "wdth", Number "25" $ NVInteger 25] `shouldBe` ([ ("wdth", 25) ], True, []) Pat.parseFontVars [String "wdth", Number "75" $ NVInteger 75] `shouldBe` ([ ("wdth", 75) ], True, []) it "To FontConfig pattern" $ do let tProp k v = longhand temp temp k $ filter (/= Whitespace) $ tokenize v let list2pat' = Pattern' . M.fromList let list2pat = Just . list2pat' tProp "font-family" "Georgia, serif" `shouldBe` list2pat [ ("family", [(Strong, ValueString "Georgia"), (Strong, ValueString "serif")]) ] tProp "font-family" "\"Gill Sans\", sans-serif" `shouldBe` list2pat [ ("family", [ (Strong, ValueString "Gill Sans"), (Strong, ValueString "sans-serif") ]) ] tProp "font-family" "sans-serif" `shouldBe` list2pat [ ("family", [(Strong, ValueString "sans-serif")]) ] tProp "font-family" "serif" `shouldBe` list2pat [ ("family", [(Strong, ValueString "serif")]) ] tProp "font-family" "cursive" `shouldBe` list2pat [ ("family", [(Strong, ValueString "cursive")]) ] tProp "font-family" "system-ui" `shouldBe` list2pat [ ("family", [(Strong, ValueString "system-ui")]) ] tProp "font-size" "1.2em" `shouldBe` list2pat [ ("size", [(Strong, ValueDouble 12)]) ] tProp "font-size" "x-small" `shouldBe` list2pat [ ("size", [(Strong, ValueDouble 7.5)]) ] tProp "font-size" "smaller" `shouldBe` list2pat [ ("size", [(Strong, ValueDouble 8.333333333333334)]) ] tProp "font-size" "12px" `shouldBe` list2pat [ ("size", [(Strong, ValueDouble $ 0.125/72)]) ] tProp "font-size" "80%" `shouldBe` list2pat [ ("size", [(Strong, ValueDouble 8)]) ] tProp "font-style" "normal" `shouldBe` list2pat [ ("slant", [(Strong, ValueInt 0)]) ] tProp "font-style" "italic" `shouldBe` list2pat [ ("slant", [(Strong, ValueInt 100)]) ] tProp "font-style" "oblique" `shouldBe` list2pat [ ("slant", [(Strong, ValueInt 110)]) ] tProp "font-style" "oblique 40deg" `shouldBe` list2pat [ ("slant", [(Strong, ValueInt 110)]) ] tProp "font-weight" "normal" `shouldBe` list2pat [ ("weight", [(Strong, ValueInt 80)]) ] tProp "font-weight" "bold" `shouldBe` list2pat [ ("weight", [(Strong, ValueInt 200)]) ] tProp "font-weight" "lighter" `shouldBe` list2pat [ ("weight", [(Strong, ValueInt 0)]) ] tProp "font-weight" "bolder" `shouldBe` list2pat [ ("weight", [(Strong, ValueInt 200)]) ] tProp "font-weight" "100" `shouldBe` list2pat [ ("weight", [(Strong, ValueInt 0)]) ] tProp "font-weight" "900" `shouldBe` list2pat [ ("weight", [(Strong, ValueInt 210)]) ] tProp "font-feature-settings" "normal" `shouldBe` list2pat [] tProp "font-feature-settings" "\"liga\" 0" `shouldBe` list2pat [ ("fontfeatures", [(Strong, ValueString "liga")]) ] tProp "font-feature-settings" "\"tnum\"" `shouldBe` list2pat [ ("fontfeatures", [(Strong, ValueString "tnum")]) ] tProp "font-feature-settings" "\"smcp\", \"zero\"" `shouldBe` list2pat [ ("fontfeatures", [ (Strong, ValueString "smcp"), (Strong, ValueString "zero") ]) ] tProp "font-variation-settings" "'wght' 50" `shouldBe` list2pat [ ("variable", [(Strong, ValueBool True)]), ("fontvariations", [(Strong, ValueString "wght")]) ] tProp "font-variation-settings" "'wght' 850" `shouldBe` list2pat [ ("variable", [(Strong, ValueBool True)]), ("fontvariations", [(Strong, ValueString "wght")]) ] tProp "font-variation-settings" "'wdth' 25" `shouldBe` list2pat [ ("variable", [(Strong, ValueBool True)]), ("fontvariations", [(Strong, ValueString "wdth")]) ] tProp "font-variation-settings" "'wdth' 75" `shouldBe` list2pat [ ("variable", [(Strong, ValueBool True)]), ("fontvariations", [(Strong, ValueString "wdth")]) ] tProp "font-stretch" "condensed" `shouldBe` list2pat [ ("width", [(Strong, ValueInt 75)]) ] tProp "font-stretch" "expanded" `shouldBe` list2pat [ ("width", [(Strong, ValueInt 125)]) ] tProp "font-stretch" "ultra-expanded" `shouldBe` list2pat [ ("width", [(Strong, ValueInt 200)]) ] tProp "font-stretch" "50%" `shouldBe` list2pat [ ("width", [(Strong, ValueInt 50)]) ] tProp "font-stretch" "100%" `shouldBe` list2pat [ ("width", [(Strong, ValueInt 100)]) ] tProp "font-stretch" "150%" `shouldBe` list2pat [ ("width", [(Strong, ValueInt 150)]) ] let tShort :: PropertyParser p => Txt.Text -> Txt.Text -> p tShort k v = let temp' = temp in foldl (\self (key, val) -> fromMaybe self $ longhand (inherit temp') self key val) temp' $ shorthand temp' k $ filter (/= Whitespace) $ tokenize v tShort "font" "1.2em 'Fira Sans', sans-serif" `shouldBe` list2pat' [ ("size", [(Strong, ValueDouble 12)]), ("family", [(Strong, ValueString "Fira Sans"), (Strong, ValueString "sans-serif")]) ] tShort "font" "italic 1.2em 'Fira Sans', serif" `shouldBe` list2pat' [ ("slant", [(Strong, ValueInt 100)]), ("size", [(Strong, ValueDouble 12)]), ("family", [(Strong, ValueString "Fira Sans"), (Strong, ValueString "serif")]), ("weight",[(Strong,ValueInt 80)]), ("width",[(Strong,ValueInt 100)]) ] tShort "font" "italic bold 16px cursive" `shouldBe` list2pat' [ ("slant", [(Strong, ValueInt 100)]), ("size", [(Strong, ValueDouble 2.3148148148148147e-3)]), ("weight", [(Strong, ValueInt 200)]), ("family", [(Strong, ValueString "cursive")]), ("width",[(Strong,ValueInt 100)]) ] it "@font-face" $ do let tRule = cssFonts . CSS.parse (emptyParser ()) let tRule' = tRule . Txt.unlines let list2pat = M.fromList tRule "" `shouldBe` [] tRule "@font-face {font-family: OpenSans}" `shouldBe` [list2pat [ ("family", [(Strong, ValueString "OpenSans")]) ]] tRule "@font-face {font-family: 'Open Sans'}" `shouldBe` [list2pat [ ("family", [(Strong, ValueString "Open Sans")]) ]] tRule "@font-face {font-stretch: condensed}" `shouldBe` [list2pat [ ("width", [(Strong, ValueInt 75)]) ]] tRule "@font-face {font-stretch: expanded}" `shouldBe` [list2pat [ ("width", [(Strong, ValueInt 125)]) ]] tRule "@font-face {font-stretch: ultra-expanded}" `shouldBe` [list2pat [ ("width", [(Strong, ValueInt 200)]) ]] tRule "@font-face {font-stretch: 50%}" `shouldBe` [list2pat [ ("width", [(Strong, ValueInt 50)]) ]] tRule "@font-face {font-stretch: 100%}" `shouldBe` [list2pat [ ("width", [(Strong, ValueInt 100)]) ]] tRule "@font-face {font-stretch: 150%}" `shouldBe` [list2pat [ ("width", [(Strong, ValueInt 150)]) ]] tRule "@font-face {font-weight: normal}" `shouldBe` [list2pat [ ("weight", [(Strong, ValueInt 80)]) ]] tRule "@font-face {font-weight: bold}" `shouldBe` [list2pat [ ("weight", [(Strong, ValueInt 200)]) ]] tRule "@font-face {font-weight: 100}" `shouldBe` [list2pat [ ("weight", [(Strong, ValueInt 0)]) ]] tRule "@font-face {font-weight: 900}" `shouldBe` [list2pat [ ("weight", [(Strong, ValueInt 210)]) ]] tRule "@font-face {font-feature-settings: normal}" `shouldBe` [list2pat []] tRule "@font-face {font-feature-settings: \"liga\" 0}" `shouldBe` [list2pat [ ("fontfeatures", [(Strong, ValueString "liga")]) ]] tRule "@font-face {font-feature-settings: \"tnum\"}" `shouldBe` [list2pat [ ("fontfeatures", [(Strong, ValueString "tnum")]) ]] tRule "@font-face {font-feature-settings: \"smcp\", \"zero\"}" `shouldBe` [list2pat [ ("fontfeatures", [ (Strong, ValueString "smcp,zero") -- Is this right? ]) ]] tRule "@font-face {font-variation-settings: 'wght' 50}" `shouldBe` [list2pat [ ("variable", [(Strong, ValueBool True)]) ]] tRule "@font-face {font-variation-settings: 'wght' 850}" `shouldBe` [list2pat [ ("variable", [(Strong, ValueBool True)]) ]] tRule "@font-face {font-variation-settings: 'wdth' 25}" `shouldBe` [list2pat [ ("variable", [(Strong, ValueBool True)]) ]] tRule "@font-face {font-variation-settings: 'wdth' 75}" `shouldBe` [list2pat [ ("variable", [(Strong, ValueBool True)]) ]] tRule "@font-face {unicode-range: U+26}" `shouldBe` [list2pat [ ("charset", [(Strong, ValueCharSet $ IS.fromList [0x26])]) ]] tRule "@font-face {unicode-range: U+0-7F}" `shouldBe` [list2pat [ ("charset", [(Strong, ValueCharSet $ IS.fromList [0..0x7f])]) ]] tRule "@font-face {unicode-range: U+0025-00FF}" `shouldBe` [list2pat [ ("charset", [(Strong, ValueCharSet $ IS.fromList [0x25..0xff])]) ]] tRule "@font-face {unicode-range: U+4??}" `shouldBe` [list2pat [ ("charset", [(Strong, ValueCharSet $ IS.fromList [0x400..0x4ff])]) ]] tRule "@font-face {unicode-range: U+0025-00FF, U+4??}" `shouldBe` [list2pat [ ("charset", [(Strong, ValueCharSet $ IS.fromList ([0x25..0xff] ++ [0x400..0x4ff]))]) ]] tRule' [ "@font-face {", " font-family: \"Trickster\";", " src:", " local(\"Trickster\"),", " url(\"trickster-COLRv1.otf\") format(\"opentype\") tech(color-COLRv1),", " url(\"trickster-outline.otf\") format(\"opentype\"),", " url(\"trickster-outline.woff\") format(\"woff\");", "}" ] `shouldBe` [list2pat [ ("family", [(Strong, ValueString "Trickster")]), ("web-src", [(Strong, ValueString "local:Trickster"), (Strong, ValueString "trickster-COLRv1.otf"), (Strong, ValueString "trickster-outline.otf"), (Strong, ValueString "trickster-outline.woff")]) ]]