List.hs

module Test.Data.List where

import qualified Data.List.Reverse.StrictElement as Rev
import qualified Data.List.HT.Private as ListHT
import qualified Data.List as List
import Control.Monad (liftM2, )

import Test.Utility (equalLists, equalInfLists, )
import Test.QuickCheck (Testable, Property, quickCheck, (==>), )

import Prelude hiding (iterate, )



takeWhileRev0 :: (Eq a) => (a -> Bool) -> [a] -> Bool
takeWhileRev0 p xs =
   ListHT.takeWhileRev0 p xs == Rev.takeWhile p xs

takeWhileRev1 :: (Eq a) => (a -> Bool) -> [a] -> Bool
takeWhileRev1 p xs =
   ListHT.takeWhileRev1 p xs == Rev.takeWhile p xs

takeWhileRev2 :: (Eq a) => (a -> Bool) -> [a] -> Bool
takeWhileRev2 p xs =
   ListHT.takeWhileRev2 p xs == Rev.takeWhile p xs

dropWhileRev :: (Eq a) => (a -> Bool) -> [a] -> Bool
dropWhileRev p xs =
   ListHT.dropWhileRev p xs == Rev.dropWhile p xs


takeRev :: (Eq a) => Int -> [a] -> Bool
takeRev n xs =
   ListHT.takeRev n xs == reverse (take n (reverse xs))

dropRev :: (Eq a) => Int -> [a] -> Bool
dropRev n xs =
   ListHT.dropRev n xs == reverse (drop n (reverse xs))

splitAtRev :: (Eq a) => Int -> [a] -> Bool
splitAtRev n xs =
   xs == uncurry (++) (ListHT.splitAtRev n xs)


breakAfterAppend :: (Eq a) => (a -> Bool) -> [a] -> Bool
breakAfterAppend p xs =
   uncurry (++) (ListHT.breakAfter p xs) == xs

breakAfter0 :: (Eq a) => (a -> Bool) -> [a] -> Bool
breakAfter0 p xs =
   ListHT.breakAfterRec p xs == ListHT.breakAfterFoldr p xs

breakAfter1 :: (Eq a) => (a -> Bool) -> [a] -> Bool
breakAfter1 p xs =
   ListHT.breakAfterRec p xs == ListHT.breakAfterBreak p xs

breakAfter2 :: (Eq a) => (a -> Bool) -> [a] -> Bool
breakAfter2 p xs =
   ListHT.breakAfterRec p xs == ListHT.breakAfterTakeUntil p xs

breakAfterUntil :: (Eq a) => (a -> Bool) -> [a] -> Bool
breakAfterUntil p xs =
   ListHT.takeUntil p xs == fst (ListHT.breakAfter p xs)


sieve :: Eq a => Int -> [a] -> Property
sieve n x =
   n>0 ==>
      equalLists [ListHT.sieve    n x,
                  ListHT.sieve'   n x,
                  ListHT.sieve''  n x,
                  ListHT.sieve''' n x]


sliceHorizontal :: Eq a => Int -> [a] -> Bool
sliceHorizontal n0 x =
   let n = 1 + mod n0 1000
   in  ListHT.sliceHorizontal n x == ListHT.sliceHorizontal' n x


sliceVertical :: Eq a => Int -> [a] -> Property
sliceVertical n x =
   n>0 ==>
      ListHT.sliceVertical n x == ListHT.sliceVertical' n x

slice :: Eq a => Int -> [a] -> a -> Bool
slice n0 as a =
   let x = a:as
       n = 1 + mod n0 (length x)
   in  -- problems: ListHT.sliceHorizontal 4 [] == [[],[],[],[]]
       ListHT.sliceHorizontal n x == List.transpose (ListHT.sliceVertical  n x)  &&
       ListHT.sliceVertical  n x == List.transpose (ListHT.sliceHorizontal n x)




shear :: Eq a => [[a]] -> Bool
shear xs =
   ListHT.shearTranspose xs  ==  map reverse (ListHT.shear xs)



outerProduct :: (Eq a, Eq b) => [a] -> [b] -> Bool
outerProduct xs ys =
   concat (ListHT.outerProduct (,) xs ys)  ==  liftM2 (,) xs ys



iterate :: Eq a => (a -> a -> a) -> a -> Bool
iterate op a =
   let xs = List.iterate (op a) a
       ys = ListHT.iterateAssociative op a
       zs = ListHT.iterateLeaky op a
   in  equalInfLists 1000 [xs, ys, zs]


mapAdjacent :: (Num a, Eq a) => a -> [a] -> Bool
mapAdjacent x xs =
   ListHT.mapAdjacent subtract (scanl (+) x xs) == xs

mapAdjacentPointfree :: (Num a, Eq a) => [a] -> Bool
mapAdjacentPointfree xs =
   ListHT.mapAdjacent (+) xs == ListHT.mapAdjacentPointfree (+) xs


simple ::
   (Testable test) =>
   (Int -> [Integer] -> test) -> IO ()
simple = quickCheck

elemCheck ::
   (Testable test) =>
   (Float -> [Float] -> test) -> IO ()
elemCheck = quickCheck


tests :: [(String, IO ())]
tests =
   ("takeWhileRev0",    elemCheck (\a -> takeWhileRev0 (a>=))) :
   ("takeWhileRev1",    elemCheck (\a -> takeWhileRev1 (a>=))) :
   ("takeWhileRev2",    elemCheck (\a -> takeWhileRev2 (a>=))) :
   ("dropWhileRev",     elemCheck (\a -> dropWhileRev (a>=))) :
   ("takeRev",          simple takeRev) :
   ("dropRev",          simple dropRev) :
   ("splitAtRev",       simple splitAtRev) :
   ("breakAfterAppend", elemCheck (\a -> breakAfterAppend (a>=))) :
   ("breakAfter0",      elemCheck (\a -> breakAfter0 (a>=))) :
   ("breakAfter1",      elemCheck (\a -> breakAfter1 (a>=))) :
   ("breakAfter2",      elemCheck (\a -> breakAfter2 (a>=))) :
   ("breakAfterUntil",  elemCheck (\a -> breakAfterUntil (a>=))) :
   ("sieve",            simple sieve) :
   ("sliceHorizontal",  simple sliceHorizontal) :
   ("sliceVertical",    simple sliceVertical) :
   ("slice",            simple slice) :
   ("shear",            quickCheck (shear           :: [[Integer]] -> Bool)) :
   ("outerProduct",     quickCheck (outerProduct    :: [Integer] -> [Int] -> Bool)) :
   ("iterate",          quickCheck (iterate (+)     :: Integer -> Bool)) :
   ("mapAdjacent",      quickCheck (mapAdjacent     :: Integer -> [Integer] -> Bool)) :
   ("mapAdjacentPointfree",
                        quickCheck (mapAdjacentPointfree :: [Integer] -> Bool)) :
   []