hugs 98.200609.21-5.4build1 / usr / lib / hugs / oldlib / TestSeq.hs

-- Copyright (c) 1999 Chris Okasaki.  
-- See COPYRIGHT file for terms and conditions.

module TestSeq
	{-# DEPRECATED "This module is unmaintained, and will disappear soon" #-}
	where
import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1,
                       filter,takeWhile,dropWhile,lookup,take,drop,splitAt,
                       zip,zip3,zipWith,zipWith3,unzip,unzip3,null)
import qualified Prelude

import EdisonPrelude(Maybe2(Just2,Nothing2))
import QuickCheck

import SimpleQueue -- the module being tested
  -- To test a different module, simply replace the name above.
  -- To test a module that does not name its type constructor "Seq",
  -- you also need to define a type synonym
  --   type Seq a = ...

prop_equals :: Seq Int -> Seq Int -> Bool
prop_equals xs ys =
    (xs == ys) == (toList xs == toList ys)

prop_fromList :: [Int] -> Bool
prop_fromList xs = 
    fromList xs == (Prelude.foldr cons empty xs :: Seq Int)
    &&
    toList (fromList xs :: Seq Int) == xs

prop_toList :: Seq Int -> Bool
prop_toList xs = 
    toList xs == foldr (:) [] xs
    &&
    fromList (toList xs) == xs

prop_single :: Int -> Bool
prop_single x =
    toList (single x :: Seq Int) == [x]

prop_cons_snoc :: Int -> Seq Int -> Bool
prop_cons_snoc x xs = 
    cons x xs == append (single x) xs
    &&
    snoc xs x == append xs (single x)

prop_lview_rview :: Seq Int -> Bool
prop_lview_rview xs =
    lview xs == (if null xs then Nothing2 else Just2 (lhead xs) (ltail xs))
    &&
    rview xs == (if null xs then Nothing2 else Just2 (rtail xs) (rhead xs))

prop_lhead_rhead :: Seq Int -> Property
prop_lhead_rhead xs =
    not (null xs) ==>
      lhead xs == Prelude.head (toList xs)
      &&
      rhead xs == Prelude.last (toList xs)

prop_ltail_rtail :: Seq Int -> Bool
prop_ltail_rtail xs =
    toList (ltail xs) == (if null xs then [] else Prelude.tail (toList xs))
    &&
    toList (rtail xs) == (if null xs then [] else Prelude.init (toList xs))

prop_append :: Seq Int -> Seq Int -> Bool
prop_append xs ys = 
    toList (append xs ys) == toList xs ++ toList ys

prop_null_size :: Seq Int -> Bool
prop_null_size xs =
    null xs == (size xs == 0)
    &&
    size xs == Prelude.length (toList xs)

prop_reverse :: Seq Int -> Bool
prop_reverse xs = 
    toList (reverse xs) == Prelude.reverse (toList xs)

prop_reverseOnto :: Seq Int -> Seq Int -> Bool
prop_reverseOnto xs ys = 
    reverseOnto xs ys == append (reverse xs) ys

prop_map :: Seq Int -> Bool
prop_map xs = 
    toList (map (+1) xs) == Prelude.map (+1) (toList xs)

prop_fold :: Seq Int -> Bool
prop_fold xs =
    foldr (:) [99] xs == toList xs ++ [99]
    &&
    foldl (flip (:)) [99] xs == Prelude.reverse (toList xs) ++ [99]

prop_fold1 :: Seq Int -> Property
prop_fold1 xs =
    not (null xs) ==> 
       foldr1 f xs == Prelude.foldr1 f (toList xs)
       &&
       foldl1 f xs == Prelude.foldl1 f (toList xs)
  where f x y = 3*x - 2*y

prop_reduce :: Seq Int -> Bool
prop_reduce xs =
    reducel append (single 93) (map single xs) == append (single 93) xs
    &&
    reducer append (single 93) (map single xs) == append xs (single 93)

prop_reduce1 :: Seq Int -> Property
prop_reduce1 xs =
    not (null xs) ==>
      reduce1 append (map single xs) == xs

prop_copy_tabulate :: Int -> Bool
prop_copy_tabulate n =
    toList (copy n 'x' :: Seq Char) == 
      (if n <= 0 then [] else Prelude.take n (repeat 'x'))
    &&
    toList (tabulate n (+13) :: Seq Int) ==
      (if n <= 0 then [] else Prelude.take n [13..])

prop_inBounds_lookup :: Int -> Seq Int -> Bool
prop_inBounds_lookup i xs =
    inBounds xs i == (0 <= i && i < size xs)
    &&
    (if inBounds xs i then
       lookup xs i == lhead (drop i xs)
       &&
       lookupM xs i == Just (lookup xs i)
       &&
       lookupWithDefault 99 xs i == lookup xs i
     else
       lookupM xs i == Nothing
       &&
       lookupWithDefault 99 xs i == 99)


prop_update_adjust :: Int -> Seq Int -> Bool
prop_update_adjust i xs =
    if inBounds xs i then
      let ys = take i xs
          zs = drop (i+1) xs
          x = lookup xs i 
      in
        update i 99 xs == append ys (cons 99 zs)
        &&
        adjust (+1) i xs == append ys (cons (x+1) zs)
    else
      update i 99 xs == xs
      &&
      adjust (+1) i xs == xs

prop_withIndex :: Seq Int -> Bool
prop_withIndex xs =
    toList (mapWithIndex (+) xs) == Prelude.map (uncurry (+)) ixs
    &&
    foldrWithIndex f [] xs == ixs
    &&
    foldlWithIndex g [] xs == Prelude.reverse ixs
  where ixs = Prelude.zip [0..] (toList xs)
        f i x xs = (i,x):xs
        g xs i x = (i,x):xs

prop_take_drop_splitAt :: Int -> Seq Int -> Bool
prop_take_drop_splitAt n xs =
    size (take n xs) == max 0 (min n (size xs))
    &&
    append (take n xs) (drop n xs) == xs
    &&
    splitAt n xs == (take n xs, drop n xs)

prop_subseq :: Int -> Int -> Seq Int -> Bool
prop_subseq i len xs =
    subseq i len xs == take len (drop i xs)

prop_filter_takeWhile_dropWhile :: Int -> Seq Int -> Bool
prop_filter_takeWhile_dropWhile x xs =
    toList (filter p xs) == Prelude.filter p (toList xs)
    &&
    toList (takeWhile p xs) == Prelude.takeWhile p (toList xs)
    &&
    toList (dropWhile p xs) == Prelude.dropWhile p (toList xs)
  where p = (< x)

prop_partition_splitWhile :: Int -> Seq Int -> Bool
prop_partition_splitWhile x xs =
    partition p xs == (filter p xs, filter (not . p) xs)
    &&
    splitWhile p xs == (takeWhile p xs, dropWhile p xs)
  where p = (< x)

prop_zip_zipWith :: Seq Int -> Seq Int -> Bool
prop_zip_zipWith xs ys =
    toList (zip xs ys) == xys
    &&
    toList (zipWith (,) xs ys) == xys
  where xys = Prelude.zip (toList xs) (toList ys)

prop_zip3_zipWith3 :: Seq Int -> Seq Int -> Seq Int -> Bool
prop_zip3_zipWith3 xs ys zs =
    toList (zip3 xs ys zs) == xyzs
    &&
    toList (zipWith3 (,,) xs ys zs) == xyzs
  where xyzs = Prelude.zip3 (toList xs) (toList ys) (toList zs)

prop_unzip_unzipWith :: Seq (Int,Int) -> Bool
prop_unzip_unzipWith xys =
    unzip xys == (xs, ys)
    &&
    unzipWith fst snd xys == (xs, ys)
  where xs = map fst xys
        ys = map snd xys

prop_unzip3_unzipWith3 :: Seq (Int,Int,Int) -> Bool
prop_unzip3_unzipWith3 xyzs =
    unzip3 xyzs == (xs, ys, zs)
    &&
    unzipWith3 fst3 snd3 thd3 xyzs == (xs, ys, zs)
  where xs = map fst3 xyzs
        ys = map snd3 xyzs
        zs = map thd3 xyzs

        fst3 (x,y,z) = x        
        snd3 (x,y,z) = y
        thd3 (x,y,z) = z        

prop_concat :: Property
prop_concat = forAll genss $ \xss -> concat xss == foldr append empty xss

genss :: Gen (Seq (Seq Int))
genss = sized (\n -> resize (min 20 n) arbitrary)

prop_concatMap :: Seq Int -> Property
prop_concatMap xs = forAll genss check
  where check xss = concatMap f xs == concat (map f xs)
            where f = lookupWithDefault empty xss