9 files changed, 95 insertions(+), 15 deletions(-)

M fontconfig-pure.cabal
M lib/Graphics/Text/Font/Choose/CharSet.hs
M lib/Graphics/Text/Font/Choose/LangSet.hs
M lib/Graphics/Text/Font/Choose/Pattern.hs
M lib/Graphics/Text/Font/Choose/Range.hs
M lib/Graphics/Text/Font/Choose/StrSet.hs
M lib/Graphics/Text/Font/Choose/Value.hs
D lib/MyLib.hs
M test/Main.hs

@@ 87,7 87,8 @@ library
     build-depends:    base >=4.12 && <5, containers >=0.1 && <1, css-syntax,
             freetype2 >=0.2 && <0.3, hashable >=1.3 && <2, linear >=1.0.1 && <2,
             scientific, stylist-traits >=0.1.1 && <1, text, msgpack >= 1.0 && <2,
-            vector >= 0.13 && <1, bytestring, stylist-traits, css-syntax
+            vector >= 0.13 && <1, bytestring, stylist-traits, css-syntax,
+            QuickCheck
 
     -- Directories containing source files.
     hs-source-dirs:   lib


@@ 144,4 145,6 @@ test-suite fontconfig-pure-test
     -- Test dependencies.
     build-depends:
         base ^>=4.17.0.0,
-        fontconfig-pure
+        fontconfig-pure,
+        hspec, QuickCheck,
+        msgpack

@@ 8,6 8,7 @@ import Data.Char (isHexDigit, ord, chr)
 import Numeric (readHex)
 
 import Data.MessagePack (MessagePack(..))
+import Test.QuickCheck (Arbitrary(..))
 
 -- | An FcCharSet is a set of Unicode characters.
 type CharSet = IntSet


@@ 51,8 52,13 @@ diffDecompress :: Int -> [Int] -> [Int]
 diffDecompress prev (x:xs) = let y = prev + x in y:diffDecompress y xs
 diffDecompress _ [] = []
 
-newtype CharSet' = CharSet' { unCharSet :: CharSet }
+newtype CharSet' = CharSet' { unCharSet :: CharSet } deriving (Eq, Read, Show)
 instance MessagePack CharSet' where
-    toObject = toObject . diffCompress 0 . IntSet.toAscList . unCharSet
+    toObject x = toObject $ diffCompress 0 $ IntSet.toAscList $ unCharSet x
     fromObject msg =
         CharSet' <$> IntSet.fromAscList <$> diffDecompress 0 <$> fromObject msg
+instance Arbitrary CharSet' where
+    arbitrary = do
+        x <- arbitrary -- Ensure its non-empty, known failure!
+        xs <- arbitrary
+        return $ CharSet' $ IntSet.insert x xs

@@ 7,6 7,7 @@ import Data.Set (Set)
 import qualified Data.Set as S
 
 import Data.MessagePack (MessagePack(..))
+import Test.QuickCheck (Arbitrary(..))
 import Graphics.Text.Font.Choose.StrSet (StrSet)
 import Graphics.Text.Font.Choose.CharSet (CharSet')
 


@@ 17,11 18,16 @@ import Graphics.Text.Font.Choose.Result
 import Control.Exception (throw)
 
 type LangSet = Set String
-newtype LangSet' = LangSet' { unLangSet :: LangSet }
+newtype LangSet' = LangSet' { unLangSet :: LangSet } deriving (Eq, Show, Read)
 
 instance MessagePack LangSet' where
     toObject = toObject . S.toList . unLangSet
     fromObject msg = LangSet' <$> S.fromList <$> fromObject msg
+instance Arbitrary LangSet' where
+    arbitrary = do
+        x <- arbitrary -- Ensure non-empty, known failure
+        xs <- arbitrary
+        return $ LangSet' $ S.insert x xs
 
 data LangComparison = SameLang | SameTerritory | DifferentLang
 i2cmp :: Int -> LangComparison

@@ 8,6 8,7 @@ module Graphics.Text.Font.Choose.Pattern(Pattern, Pattern'(..), module M, Bindin
 
 import Data.Map as M
 import Data.MessagePack (MessagePack(..), Object(..))
+import Test.QuickCheck (Arbitrary(..), chooseEnum)
 import Data.Hashable (Hashable(..))
 import GHC.Generics (Generic)
 


@@ 24,12 25,13 @@ import Graphics.Text.Font.Choose.Weight
 import Stylist (PropertyParser(..))
 import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
 import Data.Text (Text, unpack)
+import qualified Data.Text as Txt
 import Data.Scientific (toRealFloat)
 import Data.List (intercalate)
 import Data.Maybe as Mb (listToMaybe, fromMaybe, mapMaybe)
 
 type Pattern = Map Text [(Binding, Value)]
-data Pattern' = Pattern' { unPattern :: Pattern }
+data Pattern' = Pattern' { unPattern :: Pattern } deriving (Eq, Read, Show, Generic)
 data Binding = Strong | Weak | Same deriving (Eq, Ord, Enum, Read, Show, Generic)
 
 instance Hashable Binding where


@@ 43,6 45,16 @@ instance MessagePack Binding where
     toObject Weak = ObjectBool False
     toObject Same = ObjectNil
 
+instance Hashable Pattern' where hash = hash . unPattern
+instance MessagePack Pattern' where
+    fromObject = fmap Pattern' . fromObject
+    toObject = toObject . unPattern
+
+instance Arbitrary Pattern' where
+    arbitrary = Pattern' <$> M.mapKeys Txt.pack <$> arbitrary
+instance Arbitrary Binding where
+    arbitrary = chooseEnum (Strong, Same)
+
 setValue :: ToValue v => Text -> Binding -> v -> Pattern -> Pattern
 setValue key strength v self = setValues key strength [v] self
 setValues :: ToValue v => Text -> Binding -> [v] -> Pattern -> Pattern

@@ 1,11 1,15 @@
+{-# LANGUAGE DeriveGeneric #-}
 module Graphics.Text.Font.Choose.Range(Range(..), iRange) where
 
 import Data.MessagePack (MessagePack(..), Object(..))
+import Test.QuickCheck (Arbitrary(..))
+import GHC.Generics (Generic(..))
+import Data.Hashable (Hashable(..))
 import qualified Data.Vector as V
 import qualified Data.IntMap as IM
 
 -- | Matches a numeric range.
-data Range = Range Double Double deriving (Eq, Show, Ord)
+data Range = Range Double Double deriving (Eq, Read, Show, Ord, Generic)
 -- | Matches an integral range.
 iRange :: Int -> Int -> Range
 iRange i j = toEnum i `Range` toEnum j


@@ 19,3 23,6 @@ instance MessagePack Range where
         | Just msg' <- fromObject msg =
             Just (IM.findWithDefault 0 0 msg' `Range` IM.findWithDefault 0 1 msg')
         | otherwise = Nothing
+instance Arbitrary Range where
+    arbitrary = uncurry Range <$> arbitrary
+instance Hashable Range

@@ 4,9 4,12 @@ import Data.Set (Set)
 import qualified Data.Set as S
 
 import Data.MessagePack (MessagePack(..))
+import Test.QuickCheck (Arbitrary(..))
 
-newtype StrSet = StrSet { unStrSet :: Set String }
+newtype StrSet = StrSet { unStrSet :: Set String } deriving (Eq, Show, Read)
 
 instance MessagePack StrSet where
     toObject = toObject . S.toList . unStrSet
     fromObject msg = StrSet <$> S.fromList <$> fromObject msg
+instance Arbitrary StrSet where
+    arbitrary = StrSet <$> arbitrary

@@ 1,14 1,18 @@
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, DeriveGeneric #-}
 module Graphics.Text.Font.Choose.Value(Value(..), ToValue(..)) where
 
 import Linear.Matrix (M22)
 import Linear.V2 (V2(..))
+import qualified Data.Vector as V
 import Graphics.Text.Font.Choose.CharSet (CharSet, CharSet'(..))
 --import FreeType.Core.Base (FT_Face(..))
 import Graphics.Text.Font.Choose.LangSet (LangSet, LangSet'(..))
 import Graphics.Text.Font.Choose.Range (Range)
 
 import Data.MessagePack (MessagePack(..), Object(..))
+import Test.QuickCheck (Arbitrary(..), oneof)
+import GHC.Generics (Generic)
+import Data.Hashable (Hashable(..))
 import qualified Data.Text as Txt
 
 -- | A dynamic type system for `Pattern`s.


@@ 21,8 25,9 @@ data Value = ValueVoid
     | ValueCharSet CharSet
 --    | ValueFTFace FT_Face -- FIXME: Is it worth going through the trouble to bridge this?
     | ValueLangSet LangSet
-    | ValueRange Range deriving (Eq, Show, Ord)
+    | ValueRange Range deriving (Eq, Read, Show, Ord, Generic)
 
+instance Hashable Value
 instance MessagePack Value where
     toObject ValueVoid = ObjectNil
     toObject (ValueInt x) = ObjectInt x


@@ 41,6 46,7 @@ instance MessagePack Value where
     fromObject (ObjectDouble x) = Just $ ValueDouble x
     fromObject (ObjectStr x) = Just $ ValueString $ Txt.unpack x
     fromObject (ObjectBin _) = Nothing -- Would use for to transfer font faces via underlying bytes.
+    fromObject (ObjectArray x) | V.null x = Nothing -- Ambiguous!
     fromObject msg
         | Just charset <- fromObject msg = Just $ ValueCharSet $ unCharSet charset
         | Just langset <- fromObject msg = Just $ ValueLangSet $ unLangSet langset


@@ 49,6 55,20 @@ instance MessagePack Value where
             -- [Double] decoding is overly generous, potentially conflicts with above.
             Just $ ValueMatrix $ V2 (V2 xx yx) (V2 xy yy)
         | otherwise = Nothing
+instance Arbitrary Value where
+    arbitrary = oneof [
+        return ValueVoid,
+        ValueInt <$> arbitrary,
+        ValueDouble <$> arbitrary,
+        ValueString <$> arbitrary,
+        ValueBool <$> arbitrary,
+        do
+            (a, b, c, d) <- arbitrary
+            return $ ValueMatrix $ V2 (V2 a b) (V2 c d),
+        ValueCharSet <$> unCharSet <$> arbitrary,
+        ValueLangSet <$> unLangSet <$> arbitrary,
+        ValueRange <$> arbitrary
+      ]
 
 -- | Coerces compiletime types to runtime types.
 class ToValue x where

@@ 1,4 0,0 @@
-module MyLib (someFunc) where
-
-someFunc :: IO ()
-someFunc = putStrLn "someFunc"

@@ 1,4 1,31 @@
 module Main (main) where
 
+import Test.Hspec
+import Test.Hspec.QuickCheck
+
+import Data.MessagePack as MP
+import Graphics.Text.Font.Choose
+
 main :: IO ()
-main = putStrLn "Test suite not yet implemented."
+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)