capped-list-1.0: Tests.hs

-- Tests for Data.CappedList

module Main (tests) where
import Test.QuickCheck (Arbitrary, arbitrary)
import Test.Framework (Test, testGroup, defaultMain)
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Data.CappedList (CappedList (..))
import qualified Data.CappedList as CL

main :: IO ()
main = defaultMain tests

tests :: [Test]
tests =
	[ testProperty "append" $ prop_Append
	, testProperty "map" $ prop_Map (1 +)
	, testProperty "mapEither Left" $ prop_MapEither (Left  . Just . (1 +))
	, testProperty "mapEither Right" $ prop_MapEither (Right . (1 +))
	, testProperty "concatMap" $ prop_ConcatMap (return . (1 +))
	, testProperty "foldr" $ prop_FoldR (+) $ \x -> case x of
		Nothing -> 0
		Just x -> x + 2
	, testProperty "foldl" $ prop_FoldL (+) $ \x -> case x of
		Nothing -> 0
		Just x -> x + 2
	, testProperty "unfoldr Left" $ prop_UnfoldR (Left . Just)
	, let
		step x = if x > 0
			then Right (x, x `div` 10)
			else Left (Just x)
		in testProperty "unfoldr Right" $ prop_UnfoldR step
	, testProperty "length" prop_Length
	]

instance (Arbitrary cap, Arbitrary a) => Arbitrary (CappedList cap a) where
	arbitrary = do
		cap <- arbitrary
		foldr Next (Cap cap) `fmap` arbitrary

-- Pseudo type variables, for polymorphic properties
type A = Int
type B = Int
type CAP = Maybe Int

prop_Length :: CappedList CAP A -> Bool
prop_Length fl = CL.length fl == modelLength fl

prop_Append :: CappedList CAP A -> CappedList CAP A -> Bool
prop_Append x y = CL.append x y == modelAppend x y

prop_Map :: (A -> B) -> CappedList CAP A -> Bool
prop_Map f fl = CL.map f fl == modelMap f fl

prop_MapEither :: (A -> Either CAP B) -> CappedList CAP A -> Bool
prop_MapEither f fl = CL.mapEither f fl == modelMapEither f fl

prop_FoldR :: (A -> B -> B) -> (CAP -> B) -> CappedList CAP A -> Bool
prop_FoldR f z fl = CL.foldr f z fl == modelFoldR f z fl

prop_FoldL :: (B -> A -> B) -> (CAP -> B) -> CappedList CAP A -> Bool
prop_FoldL f z fl = CL.foldl f z fl == modelFoldL f z fl

prop_UnfoldR :: (B -> Either CAP (A, B)) -> B -> Bool
prop_UnfoldR f nil = CL.unfoldr f nil == modelUnfoldR f nil

prop_ConcatMap :: (A -> CappedList CAP B) -> CappedList CAP A -> Bool
prop_ConcatMap f fl = CL.concatMap f fl == modelConcatMap f fl

-- Versions of the basic operations, inefficient but known to be correct.
modelLength :: CappedList cap a -> Int
modelLength (Cap _)     = 0
modelLength (Next x xs) = 1 + modelLength xs

modelAppend :: CappedList cap a -> CappedList cap a -> CappedList cap a
modelAppend (Cap x)     _ = Cap x
modelAppend (Next x xs) y = Next x (modelAppend xs y)

modelMap :: (a -> b) -> CappedList cap a -> CappedList cap b
modelMap _ (Cap x)     = Cap x
modelMap f (Next x xs) = Next (f x) (modelMap f xs)

modelMapEither :: (a -> Either cap b) -> CappedList cap a -> CappedList cap b
modelMapEither _ (Cap x) = Cap x
modelMapEither f (Next x xs) = case f x of
	Left cap -> Cap cap
	Right x' -> Next x' (modelMapEither f xs)

modelConcatMap :: (a -> CappedList cap b) -> CappedList cap a -> CappedList cap b
modelConcatMap _ (Cap x)     = Cap x
modelConcatMap f (Next x xs) = modelAppend (f x) (modelConcatMap f xs)

modelFoldR :: (a -> b -> b) -> (cap -> b) -> CappedList cap a -> b
modelFoldR _ z (Cap x)     = z x
modelFoldR f z (Next x xs) = f x (modelFoldR f z xs)

modelFoldL :: (b -> a -> b) -> (cap -> b) -> CappedList cap a -> b
modelFoldL _ z (Cap x)     = z x
modelFoldL f z (Next x xs) = modelFoldL f (\cap -> f (z cap) x) xs

modelUnfoldR :: (b -> Either cap (a, b)) -> b -> CappedList cap a
modelUnfoldR f = unfoldr' where
	unfoldr' x = case f x of
		Left cap -> Cap cap
		Right (a, b) -> Next a (unfoldr' b)