From c71ba262a73912d376d731a5bd766a40bc8af9d3 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Fri, 28 Jun 2024 13:16:36 +1200
Subject: [PATCH] Test font weight conversion & font name parsing.

---
 lib/Graphics/Text/Font/Choose/Weight.hs |  8 +++---
 test/Main.hs                            | 35 +++++++++++++++++++++++++
 2 files changed, 39 insertions(+), 4 deletions(-)

diff --git a/lib/Graphics/Text/Font/Choose/Weight.hs b/lib/Graphics/Text/Font/Choose/Weight.hs
index 256b02a..90b1b56 100644
--- a/lib/Graphics/Text/Font/Choose/Weight.hs
+++ b/lib/Graphics/Text/Font/Choose/Weight.hs
@@ -17,8 +17,8 @@ foreign import capi "fontconfig/fontconfig.h FcWeightFromOpenTypeDouble"
 foreign import capi "fontconfig/fontconfig.h FcWeightToOpenTypeDouble"
     weightToOpenTypeDouble :: Double -> Double
 -- | Like weightFromOpenTypeDouble but with integer arguments. Use the other function instead.
-foreign import capi "fontconfig/fontconfig.h FcWeightFromOpenType"
-    weightFromOpenType :: Int -> Int
+weightFromOpenType :: Int -> Int
+weightFromOpenType = fromEnum . weightFromOpenTypeDouble . toEnum
 -- | Like weightToOpenTypeDouble but with integer arguments. Use the other function instead.
-foreign import capi "fontconfig/fontconfig.h FcWeightToOpenType" 
-    weightToOpenType :: Int -> Int
+weightToOpenType :: Int -> Int
+weightToOpenType = fromEnum . weightToOpenTypeDouble . toEnum
diff --git a/test/Main.hs b/test/Main.hs
index 1c27e81..a8b3725 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -11,6 +11,7 @@ import qualified Data.Map as M
 import qualified Data.Set as S
 import qualified Data.Text as Txt
 import Data.Maybe (isJust)
+import GHC.Real (infinity)
 
 import Graphics.Text.Font.Choose
 import Graphics.Text.Font.Choose.Internal.Test
@@ -96,3 +97,37 @@ main = hspec $ do
             -- 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)])
+              ]
-- 
2.30.2