bimap-0.2: Test/Tests.hs

module Test.Tests where

import Prelude hiding (null)
import Test.QuickCheck

import Data.Bimap


instance (Ord a, Arbitrary a, Ord b, Arbitrary b)
    => Arbitrary (Bimap a b) where
    arbitrary = fromList `fmap` arbitrary
    coarbitrary = coarbitrary . toList


prop_size_empty = size empty == 0

prop_null_empty = null empty

-- (heh, this is probably made redundant by polymorphism)
prop_fromList_toList xs =
    let xs' = toList . fromList $ xs
    in all (flip elem xs) xs'
    where
    _ = xs :: [(Int, Integer)]

-- when converting a list to a bimap, each list element either
-- ends up in the bimap, or could conceivably have been clobbered
prop_fromList_account xs = all (\x -> isMember x || notUnique x) xs
    where
    _ = xs :: [(Int, Integer)]
    bi = fromList xs
    isMember x = x `pairMember` bi
    notUnique (x, y) = 
        ((>1) . length . filter (== x) . map fst $ xs) ||
        ((>1) . length . filter (== y) . map snd $ xs)

prop_fromList_size xs = (size $ fromList xs) <= length xs
    where
    _ = xs :: [(Int, Integer)]

-- if we insert a pair with an existing value, the old value's twin
-- is no longer in the bimap
prop_clobberL bi b' =
    (not . null $ bi) && (b' `notMemberR` bi)
    ==>
    (a, b) `pairNotMember` insert a b' bi
    where
    (a, b) = head . toList $ bi :: (Int, Integer)

prop_clobberR bi a' =
    (not . null $ bi) && (a' `notMember` bi)
    ==>
    (a, b) `pairNotMember` insert a' b bi
    where
    (a, b) = head . toList $ bi :: (Int, Integer)

-- an arbitrary bimap is valid
prop_valid bi = valid bi
    where
    _ = bi :: Bimap Int Integer

prop_member_twin bi = flip all (toList bi) $ \(x, y) -> and
    [ (bi !  x) `memberR` bi
    , (bi !> y) `member`  bi
    ]
    where
    _ = bi :: Bimap Int Integer

prop_delete bi = flip all (toList bi) $ \(x, y) -> and
    [ x `notMember`  delete  x bi
    , y `notMemberR` deleteR y bi
    ]
    where
    _ = bi :: Bimap Int Integer

prop_delete_twin bi = flip all (toList bi) $ \(x, y) -> and
    [ (bi !  x) `notMemberR` delete  x bi
    , (bi !> y) `notMember`  deleteR y bi
    ]
    where
    _ = bi :: Bimap Int Integer

prop_singleton x y = let bi = singleton x y in and
    [ valid bi
    , (x, y) `pairMember` bi
    , (bi !  x) == y
    , (bi !> y) == x
    , size bi == 1
    ]
    where
    _ = (x, y) :: (Int, Integer)

prop_twist_twist bi =
    bi == (twist . twist $ bi)
    where
    _ = bi :: Bimap Int Integer