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 Data.Maybe.HT (toMaybe, )
import Control.Monad (liftM2, )

import qualified Test.QuickCheck.Modifiers as Mod
import qualified Test.QuickCheck as QC
import Test.Utility (equalLists, equalInfLists, )
import Test.QuickCheck (Arbitrary, 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)


geMaybe :: Float -> Float -> Maybe Integer
geMaybe x y = toMaybe (x < y) (round y)

dropWhileNothing :: Float -> [Float] -> Bool
dropWhileNothing x xs =
   ListHT.dropWhileNothing (geMaybe x) xs
   ==
   ListHT.dropWhileNothingRec (geMaybe x) xs

dropWhileNothingBreakJust :: Float -> [Float] -> Bool
dropWhileNothingBreakJust x xs =
   snd (ListHT.breakJust (geMaybe x) xs)
   ==
   ListHT.dropWhileNothing (geMaybe x) xs

breakJustRemoveEach :: Float -> [Float] -> Bool
breakJustRemoveEach x xs =
   ListHT.breakJust (geMaybe x) xs == ListHT.breakJustRemoveEach (geMaybe x) xs

breakJustPartial :: Float -> [Float] -> Bool
breakJustPartial x xs =
   ListHT.breakJust (geMaybe x) xs == ListHT.breakJustPartial (geMaybe x) xs


sieve :: Eq a => Mod.Positive Int -> [a] -> Bool
sieve (Mod.Positive n) x =
   equalLists $
      (ListHT.sieve    n x) :
      (ListHT.sieve'   n x) :
      (ListHT.sieve''  n x) :
      (ListHT.sieve''' n x) :
      []


sliceHorizontal :: Eq a => [a] -> Property
sliceHorizontal x =
   QC.forAll (QC.choose (1,1000)) $ \n ->
      ListHT.sliceHorizontal n x == ListHT.sliceHorizontal' n x


sliceVertical :: Eq a => Mod.Positive Int -> [a] -> Bool
sliceVertical (Mod.Positive n) x =
   ListHT.sliceVertical n x == ListHT.sliceVertical' n x

slice :: Eq a => Mod.NonEmptyList a -> Property
slice (Mod.NonEmpty x) =
   QC.forAll (QC.choose (1, length x)) $ \n ->
      -- 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


lengthAtLeast :: Int -> [a] -> Bool
lengthAtLeast n xs =
   ListHT.lengthAtLeast n xs  ==  (length xs >= n)

lengthAtMost :: Int -> [a] -> Bool
lengthAtMost n xs =
   ListHT.lengthAtMost n xs  ==  (length xs <= n)

lengthAtMost0 :: Int -> [a] -> Bool
lengthAtMost0 n xs =
   ListHT.lengthAtMost0 n xs  ==  (length xs <= n)


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 ::
   (Show int, Arbitrary int, 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>=))) :
   ("dropWhileNothing", elemCheck dropWhileNothing) :
   ("dropWhileNothingBreakJust",
                        elemCheck dropWhileNothingBreakJust) :
   ("breakJustRemoveEach",
                        elemCheck breakJustRemoveEach) :
   ("breakJustPartial", elemCheck breakJustPartial) :
   ("sieve",            simple sieve) :
   ("sliceHorizontal",  quickCheck (sliceHorizontal :: String -> Property)) :
   ("sliceVertical",    simple sliceVertical) :
   ("slice",            quickCheck (slice :: Mod.NonEmptyList Char -> Property)) :
   ("shear",            quickCheck (shear           :: [[Integer]] -> Bool)) :
   ("outerProduct",     quickCheck (outerProduct    :: [Integer] -> [Int] -> Bool)) :
   ("lengthAtLeast",    simple lengthAtLeast) :
   ("lengthAtMost",     simple lengthAtMost) :
   ("lengthAtMost0",    simple lengthAtMost0) :
   ("iterate",          quickCheck (iterate (+)     :: Integer -> Bool)) :
   ("mapAdjacent",      quickCheck (mapAdjacent     :: Integer -> [Integer] -> Bool)) :
   ("mapAdjacentPointfree",
                        quickCheck (mapAdjacentPointfree :: [Integer] -> Bool)) :
   []