{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- | Tests for the 'Data.HashSet' module. We test functions by
-- comparing them to a simpler model, a list.
module Main (main) where
import qualified Data.Foldable as Foldable
import Data.Hashable (Hashable(hash))
import qualified Data.List as L
import qualified Data.HashSet as S
import qualified Data.Set as Set
import Test.QuickCheck (Arbitrary)
import Test.Framework (Test, defaultMain, testGroup)
import Test.Framework.Providers.QuickCheck2 (testProperty)
-- Key type that generates more hash collisions.
newtype Key = K { unK :: Int }
deriving (Arbitrary, Eq, Ord, Show)
instance Hashable Key where
hash k = hash (unK k) `mod` 20
------------------------------------------------------------------------
-- * Properties
------------------------------------------------------------------------
-- ** Instances
pEq :: [Key] -> [Key] -> Bool
pEq xs = (unique xs ==) `eq` (S.fromList xs ==)
pNeq :: [Key] -> [Key] -> Bool
pNeq xs = (unique xs /=) `eq` (S.fromList xs /=)
pFoldable :: [Int] -> Bool
pFoldable = (L.sort . Foldable.foldr (:) []) `eq`
(L.sort . Foldable.foldr (:) [])
------------------------------------------------------------------------
-- ** Basic interface
pSize :: [Key] -> Bool
pSize = length `eq` S.size
pMember :: Key -> [Key] -> Bool
pMember k = L.elem k `eq` S.member k
pInsert :: Key -> [Key] -> Bool
pInsert a = insert a `eq` (toAscList . S.insert a)
pDelete :: Key -> [Key] -> Bool
pDelete a = delete a `eq` (toAscList . S.delete a)
------------------------------------------------------------------------
-- ** Combine
pUnion :: [Key] -> [Key] -> Bool
pUnion xs ys = L.sort (L.union as bs) ==
toAscList (S.union (S.fromList as) (S.fromList bs))
where
as = fromList xs
bs = fromList ys
------------------------------------------------------------------------
-- ** Transformations
pMap :: [Key] -> Bool
pMap = map f `eq` (toAscList . S.map f)
where f (K k) = K (k + 1)
------------------------------------------------------------------------
-- ** Folds
pFoldr :: [Int] -> Bool
pFoldr = (L.sort . L.foldr (:) []) `eq`
(L.sort . S.foldr (:) [])
pFoldl' :: Int -> [Int] -> Bool
pFoldl' z0 = L.foldl' (+) z0 `eq` S.foldl' (+) z0
------------------------------------------------------------------------
-- ** Conversions
pToList :: [Key] -> Bool
pToList = id `eq` toAscList
------------------------------------------------------------------------
-- * Test list
tests :: [Test]
tests =
[
-- Instances
testGroup "instances"
[ testProperty "==" pEq
, testProperty "/=" pNeq
, testProperty "Foldable" pFoldable
]
-- Basic interface
, testGroup "basic interface"
[ testProperty "size" pSize
, testProperty "member" pMember
, testProperty "insert" pInsert
, testProperty "delete" pDelete
]
-- Combine
, testProperty "union" pUnion
-- Transformations
, testProperty "map" pMap
-- Folds
, testGroup "folds"
[ testProperty "foldr" pFoldr
, testProperty "foldl'" pFoldl'
]
-- Conversions
, testGroup "conversions"
[ testProperty "toList" pToList
]
]
------------------------------------------------------------------------
-- * Model
-- Invariant: the list is sorted in ascending order, by key.
type Model a = [a]
-- | Check that a function operating on a 'HashMap' is equivalent to
-- one operating on a 'Model'.
eq :: (Eq a, Hashable a, Ord a, Eq b)
=> (Model a -> b) -- ^ Function that modifies a 'Model' in the same
-- way
-> (S.HashSet a -> b) -- ^ Function that modified a 'HashSet'
-> [a] -- ^ Initial content of the 'HashSet' and 'Model'
-> Bool -- ^ True if the functions are equivalent
eq f g xs = g (S.fromList ys) == f ys
where ys = fromList xs
insert :: Ord a => a -> Model a -> Model a
insert x [] = [x]
insert x (y:xs)
| x == y = x : xs
| x > y = y : insert x xs
| otherwise = x : y : xs
delete :: Ord a => a -> Model a -> Model a
delete _ [] = []
delete k ys@(y:xs)
| k == y = xs
| k > y = y : delete k xs
| otherwise = ys
-- | Create a model from a list of key-value pairs. If the input
-- contains multiple entries for the same key, the latter one is used.
fromList :: Ord a => [a] -> Model a
fromList = L.foldl' (\ m p -> insert p m) []
------------------------------------------------------------------------
-- * Test harness
main :: IO ()
main = defaultMain tests
------------------------------------------------------------------------
-- * Helpers
toAscList :: Ord a => S.HashSet a -> [a]
toAscList = L.sort . S.toList
unique :: (Eq a, Ord a) => [a] -> [a]
unique = Set.toList . Set.fromList