{-# 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(..))
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
"I'm procrastinating this" `shouldBe` "I'm procrastinating this"