psqueues-0.2.7.2: tests/Data/PSQ/Class/Tests.hs
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Data.PSQ.Class.Tests
( tests
) where
import Control.Applicative ((<$>))
import Control.DeepSeq (NFData, rnf)
import Data.Char (isAlphaNum, isPrint, ord, toLower)
import Data.Foldable (Foldable, foldr)
import qualified Data.List as List
import Data.Tagged (Tagged (..), untag)
import Prelude hiding (foldr, lookup, map, null)
import Test.HUnit (Assertion, assert, (@?=))
import Test.QuickCheck (Arbitrary (..), Property, forAll, (==>))
import Test.Tasty (TestTree)
import Test.Tasty.HUnit (testCase)
import Test.Tasty.QuickCheck (testProperty)
import Data.PSQ.Class
import Data.PSQ.Class.Gen
import Data.PSQ.Class.Util
--------------------------------------------------------------------------------
-- Index of tests
--------------------------------------------------------------------------------
tests
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Eq (psq Int Char),
Foldable (psq Int),
Functor (psq Int),
NFData (psq Int Char),
Show (psq Int Char))
=> Tagged psq [TestTree]
tests = Tagged
[ testCase "rnf" (untag' test_rnf)
, testCase "equality" (untag' test_equality)
, testCase "size" (untag' test_size)
, testCase "size2" (untag' test_size2)
, testCase "empty" (untag' test_empty)
, testCase "lookup" (untag' test_lookup)
, testCase "findMin" (untag' test_findMin)
, testCase "alter" (untag' test_alter)
, testCase "alterMin" (untag' test_alterMin)
, testCase "fromList" (untag' test_fromList)
, testCase "foldr" (untag' test_foldr)
, testProperty "show" (untag' prop_show)
, testProperty "rnf" (untag' prop_rnf)
, testProperty "size" (untag' prop_size)
, testProperty "singleton" (untag' prop_singleton)
, testProperty "memberLookup" (untag' prop_memberLookup)
, testProperty "insertLookup" (untag' prop_insertLookup)
, testProperty "insertDelete" (untag' prop_insertDelete)
, testProperty "insertDeleteView" (untag' prop_insertDeleteView)
, testProperty "deleteNonMember" (untag' prop_deleteNonMember)
, testProperty "deleteMin" (untag' prop_deleteMin)
, testProperty "alter" (untag' prop_alter)
, testProperty "alterMin" (untag' prop_alterMin)
, testProperty "toList" (untag' prop_toList)
, testProperty "keys" (untag' prop_keys)
, testProperty "insertView" (untag' prop_insertView)
, testProperty "deleteView" (untag' prop_deleteView)
, testProperty "map" (untag' prop_map)
, testProperty "unsafeMapMonotonic" (untag' prop_unsafeMapMonotonic)
, testProperty "fmap" (untag' prop_fmap)
, testProperty "fold'" (untag' prop_fold')
, testProperty "foldr" (untag' prop_foldr)
, testProperty "valid" (untag' prop_valid)
, testProperty "atMostView" (untag' prop_atMostView)
]
where
untag' :: Tagged psq test -> test
untag' = untag
--------------------------------------------------------------------------------
-- HUnit tests
--------------------------------------------------------------------------------
test_rnf
:: forall psq. (PSQ psq, TestKey (Key psq),
NFData (psq Int Char))
=> Tagged psq Assertion
test_rnf = Tagged $
rnf (empty :: psq Int Char) `seq` return ()
test_equality
:: forall psq. (PSQ psq, TestKey (Key psq),
Eq (psq Int Char))
=> Tagged psq Assertion
test_equality = Tagged $ do
-- Mostly to get 100% coverage
assert $ e /= s
assert $ s /= e
where
e = empty :: psq Int Char
s = singleton 3 100 'a' :: psq Int Char
test_size
:: forall psq. (PSQ psq, TestKey (Key psq))
=> Tagged psq Assertion
test_size = Tagged $ do
null (empty :: psq Int Char) @?= True
null (singleton 1 100 'a' :: psq Int Char) @?= False
test_size2
:: forall psq. (PSQ psq, TestKey (Key psq))
=> Tagged psq Assertion
test_size2 = Tagged $ do
size (empty :: psq Int ()) @?= 0
size (singleton 1 100 'a' :: psq Int Char) @?= 1
size (fromList [(1, 100, 'a'), (2, 101, 'c'), (3, 102, 'b')]
:: psq Int Char) @?= 3
test_empty
:: forall psq. (PSQ psq, TestKey (Key psq))
=> Tagged psq Assertion
test_empty = Tagged $ do
toList (empty :: psq Int ()) @?= []
size (empty :: psq Char Int) @?= 0
test_lookup
:: forall psq. (PSQ psq, TestKey (Key psq))
=> Tagged psq Assertion
test_lookup = Tagged $ do
employeeCurrency 1 @?= Just 1
employeeCurrency 2 @?= Nothing
where
employeeDept = fromList [(1, 100, 2), (3, 101, 1)] :: psq Int Int
deptCountry = fromList [(1, 102, 1), (2, 103, 2)] :: psq Int Int
countryCurrency = fromList [(1, 104, 2), (2, 105, 1)] :: psq Int Int
employeeCurrency :: Int -> Maybe Int
employeeCurrency name = do
dept <- snd <$> lookup (toTestKey name) employeeDept
country <- snd <$> lookup (toTestKey dept) deptCountry
snd <$> lookup (toTestKey country) countryCurrency
test_findMin
:: forall psq. (PSQ psq, TestKey (Key psq))
=> Tagged psq Assertion
test_findMin = Tagged $ do
findMin (empty :: psq Int Char) @?= Nothing
findMin (fromList [(5, 101, 'a'), (3, 100, 'b')] :: psq Int Char) @?=
Just (3, 100, 'b')
test_alter
:: forall psq. (PSQ psq, TestKey (Key psq),
Eq (psq Int Char), Show (psq Int Char))
=> Tagged psq Assertion
test_alter = Tagged $ do
alter f 3 (empty :: psq Int Char) @?= ("Hello", singleton 3 100 'a')
alter f 3 (singleton 3 100 'a' :: psq Int Char) @?= ("World", empty)
alter f 3 (singleton 3 100 'b' :: psq Int Char) @?=
("Cats", singleton 3 101 'b')
where
f Nothing = ("Hello", Just (100, 'a'))
f (Just (100, 'a')) = ("World", Nothing)
f (Just _) = ("Cats", Just (101, 'b'))
test_alterMin
:: forall psq. (PSQ psq, TestKey (Key psq),
Eq (psq Int Char), Show (psq Int Char))
=> Tagged psq Assertion
test_alterMin = Tagged $ do
alterMin (\_ -> ((), Nothing)) (empty :: psq Int Char) @?= ((), empty)
alterMin (\_ -> ((), Nothing)) (singleton 3 100 'a' :: psq Int Char) @?=
((), empty)
test_fromList
:: forall psq. (PSQ psq, TestKey (Key psq),
Eq (psq Int Char), Show (psq Int Char))
=> Tagged psq Assertion
test_fromList = Tagged $
let ls = [(1, 0, 'A'), (2, 0, 'B'), (3, 0, 'C'), (4, 0, 'D')]
in (fromList ls :: psq Int Char) @?= fromList (reverse ls)
test_foldr
:: forall psq. (PSQ psq, TestKey (Key psq),
Foldable (psq Int))
=> Tagged psq Assertion
test_foldr = Tagged $
foldr (\x acc -> acc + ord x) 0 (empty :: psq Int Char) @?= 0
--------------------------------------------------------------------------------
-- QuickCheck properties
--------------------------------------------------------------------------------
-- | For 100% test coverage...
prop_show
:: forall psq. (PSQ psq, TestKey (Key psq),
Show (psq Int Char))
=> Tagged psq Property
prop_show = Tagged $
forAll arbitraryPSQ $ \t ->
length (coverShowInstance (t :: psq Int Char)) > 0
-- | For 100% test coverage...
prop_rnf
:: forall psq. (PSQ psq, TestKey (Key psq),
NFData (psq Int Char), Show (psq Int Char))
=> Tagged psq Property
prop_rnf = Tagged $
forAll arbitraryPSQ $ \t ->
rnf (t :: psq Int Char) `seq` True
prop_size
:: forall psq. (PSQ psq, TestKey (Key psq),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_size = Tagged $ \t ->
size (t :: psq Int Char) == length (toList t)
prop_singleton
:: forall psq. (PSQ psq, TestKey (Key psq),
Eq (psq Int Char))
=> Tagged psq Property
prop_singleton = Tagged $
forAll arbitraryTestKey $ \k ->
forAll arbitraryPriority $ \p ->
forAll arbitrary $ \x ->
insert k p x empty == (singleton k p x :: psq Int Char)
prop_memberLookup
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Property)
prop_memberLookup = Tagged $ \t ->
forAll arbitraryTestKey $ \k ->
case lookup k (t :: psq Int Char) of
Nothing -> not (member k t)
Just _ -> member k t
prop_insertLookup
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Property)
prop_insertLookup = Tagged $ \t ->
forAll arbitraryTestKey $ \k ->
forAll arbitraryPriority $ \p ->
forAll arbitrary $ \c ->
lookup k (insert k p c (t :: psq Int Char)) == Just (p, c)
prop_insertDelete
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Eq (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Property)
prop_insertDelete = Tagged $ \t ->
forAll arbitraryTestKey $ \k ->
forAll arbitraryPriority $ \p ->
forAll arbitrary $ \c ->
(lookup k t == Nothing) ==>
(delete k (insert k p c t) == (t :: psq Int Char))
prop_insertDeleteView
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Eq (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Property)
prop_insertDeleteView = Tagged $ \t ->
forAll arbitraryTestKey $ \k ->
forAll arbitraryPriority $ \p ->
forAll arbitrary $ \c ->
case deleteView k (insert k p c (t :: psq Int Char)) of
Nothing -> False
Just (p', c', t')
| member k t -> p' == p && c' == c && size t' < size t
| otherwise -> p' == p && c' == c && t' == t
prop_deleteNonMember
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Eq (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Property)
prop_deleteNonMember = Tagged $ \t ->
forAll arbitraryTestKey $ \k ->
(lookup k t == Nothing) ==> (delete k t == (t :: psq Int Char))
prop_deleteMin
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Eq (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_deleteMin = Tagged $ \t ->
let t' = deleteMin t
in if null t
then t' == t
else case findMin t of
Nothing -> False
Just (k, _, _) ->
size t' == size t - 1 && member k t && not (member k t')
prop_alter
:: forall psq. (PSQ psq, TestKey (Key psq),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Property)
prop_alter = Tagged $ \t ->
forAll arbitraryTestKey $ \k ->
let ((), t') = alter f k t :: ((), psq Int Char)
in case lookup k t of
Just _ -> (size t - 1) == size t' && lookup k t' == Nothing
Nothing -> (size t + 1) == size t' && lookup k t' /= Nothing
where
f Nothing = ((), Just (100, 'a'))
f (Just _) = ((), Nothing)
prop_alterMin
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Eq (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_alterMin = Tagged $ \t ->
let (mbMin, t') = alterMin f (t :: psq Int Char)
in case mbMin of
Nothing -> t' == singleton 3 100 'a'
Just (k, p, v) ->
findMin t == Just (k, p, v) &&
member k t &&
(case () of
_ | isAlphaNum v -> lookup k t' == Just (fromTestKey k, v)
| isPrint v -> lookup (toTestKey $ ord v) t' ==
Just (ord v, v)
| otherwise -> not (member k t'))
where
f Nothing = (Nothing, Just (3, 100, 'a'))
f (Just (k, p, v))
| isAlphaNum v = (Just (k, p, v), Just (k, fromTestKey k, v))
| isPrint v = (Just (k, p, v), Just (toTestKey (ord v), ord v, v))
| otherwise = (Just (k, p, v), Nothing)
prop_toList
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Eq (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_toList = Tagged $ \t ->
(t :: psq Int Char) == fromList (toList t)
prop_keys
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_keys = Tagged $ \t ->
List.sort (keys (t :: psq Int Char)) ==
List.sort [k | (k, _, _) <- toList t]
prop_insertView
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Property)
prop_insertView = Tagged $ \t ->
forAll arbitraryTestKey $ \k ->
forAll arbitraryPriority $ \p ->
forAll arbitrary $ \x ->
case insertView k p x (t :: psq Int Char) of
(mbPx, t') ->
lookup k t == mbPx && lookup k t' == Just (p, x)
prop_deleteView
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Property)
prop_deleteView = Tagged $ \t ->
forAll arbitraryTestKey $ \k ->
case deleteView k (t :: psq Int Char) of
Nothing -> not (member k t)
Just (p, v, t') -> lookup k t == Just (p, v) && not (member k t')
prop_map
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Eq (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_map = Tagged $ \t ->
map f (t :: psq Int Char) ==
fromList (List.map (\(k, p, x) -> (k, p, f k p x)) (toList t))
where
f k p x = if fromEnum k > p then x else 'a'
prop_unsafeMapMonotonic
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Eq (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_unsafeMapMonotonic = Tagged $ \t ->
let t' = unsafeMapMonotonic f (t :: psq Int Char) :: psq Int Char in
valid t' &&
t' == fromList (List.map (\(k, p, x) -> let (p', x') = f k p x in (k, p', x'))
(toList t))
where
f k p x = (p + 1, if fromEnum k > p then x else 'a')
prop_fmap
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Eq (psq Int Char),
Functor (psq Int),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_fmap = Tagged $ \t ->
fmap toLower (t :: psq Int Char) ==
fromList (List.map (\(p, v, x) -> (p, v, toLower x)) (toList t))
prop_fold'
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_fold' = Tagged $ \t ->
fold' f acc0 (t :: psq Int Char) ==
List.foldl' (\acc (k, p, x) -> f k p x acc) acc0 (toList t)
where
-- Needs to be commutative
f k p x (kpSum, xs) = (kpSum + fromEnum k + p, List.sort (x : xs))
acc0 = (0, [])
prop_foldr
:: forall psq. (PSQ psq,
Arbitrary (psq Int Char),
Foldable (psq Int),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_foldr = Tagged $ \t ->
foldr f 0 (t :: psq Int Char) ==
List.foldr (\(_, _, x) acc -> f x acc) 0 (toList t)
where
f x acc = acc + ord x
prop_valid
:: forall psq. (PSQ psq,
Arbitrary (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_valid = Tagged valid
prop_atMostView
:: forall psq. (PSQ psq, Show (Key psq), Show (psq Int Char))
=> Tagged psq (psq Int Char -> Property)
prop_atMostView = Tagged $ \t ->
forAll arbitraryPriority $ \p ->
let (elems, t') = atMostView p t in
-- 1. Test that priorities are at most 'p'.
and [p' <= p | (_, p', _) <- elems] &&
-- 2. Test that the remaining priorities are larger than 'p'.
(case findMin t' of
Nothing -> True
Just (_, p', _) -> p' > p) &&
-- 2. Test that the size of the removed elements and the new queue total
-- the original size.
length elems + size t' == size t