{-# 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"