1module Test.Data.List where
2
3import qualified Data.List.Reverse.StrictElement as Rev
4import qualified Data.List.HT.Private as ListHT
5import qualified Data.List as List
6import Data.Maybe.HT (toMaybe, )
7import Control.Monad (liftM2, )
8
9import qualified Test.QuickCheck.Modifiers as Mod
10import qualified Test.QuickCheck as QC
11import Test.Utility (equalLists, equalInfLists, )
12import Test.QuickCheck (Arbitrary, Testable, Property, quickCheck, )
13
14import Prelude hiding (iterate, )
15
16
17
18takeWhileRev0 :: (Eq a) => (a -> Bool) -> [a] -> Bool
19takeWhileRev0 p xs =
20   ListHT.takeWhileRev0 p xs == Rev.takeWhile p xs
21
22takeWhileRev1 :: (Eq a) => (a -> Bool) -> [a] -> Bool
23takeWhileRev1 p xs =
24   ListHT.takeWhileRev1 p xs == Rev.takeWhile p xs
25
26takeWhileRev2 :: (Eq a) => (a -> Bool) -> [a] -> Bool
27takeWhileRev2 p xs =
28   ListHT.takeWhileRev2 p xs == Rev.takeWhile p xs
29
30dropWhileRev :: (Eq a) => (a -> Bool) -> [a] -> Bool
31dropWhileRev p xs =
32   ListHT.dropWhileRev p xs == Rev.dropWhile p xs
33
34
35takeRev :: (Eq a) => Int -> [a] -> Bool
36takeRev n xs =
37   ListHT.takeRev n xs == reverse (take n (reverse xs))
38
39dropRev :: (Eq a) => Int -> [a] -> Bool
40dropRev n xs =
41   ListHT.dropRev n xs == reverse (drop n (reverse xs))
42
43splitAtRev :: (Eq a) => Int -> [a] -> Bool
44splitAtRev n xs =
45   xs == uncurry (++) (ListHT.splitAtRev n xs)
46
47
48breakAfterAppend :: (Eq a) => (a -> Bool) -> [a] -> Bool
49breakAfterAppend p xs =
50   uncurry (++) (ListHT.breakAfter p xs) == xs
51
52breakAfter0 :: (Eq a) => (a -> Bool) -> [a] -> Bool
53breakAfter0 p xs =
54   ListHT.breakAfterRec p xs == ListHT.breakAfterFoldr p xs
55
56breakAfter1 :: (Eq a) => (a -> Bool) -> [a] -> Bool
57breakAfter1 p xs =
58   ListHT.breakAfterRec p xs == ListHT.breakAfterBreak p xs
59
60breakAfter2 :: (Eq a) => (a -> Bool) -> [a] -> Bool
61breakAfter2 p xs =
62   ListHT.breakAfterRec p xs == ListHT.breakAfterTakeUntil p xs
63
64breakAfterUntil :: (Eq a) => (a -> Bool) -> [a] -> Bool
65breakAfterUntil p xs =
66   ListHT.takeUntil p xs == fst (ListHT.breakAfter p xs)
67
68
69geMaybe :: Float -> Float -> Maybe Integer
70geMaybe x y = toMaybe (x < y) (round y)
71
72dropWhileNothing :: Float -> [Float] -> Bool
73dropWhileNothing x xs =
74   ListHT.dropWhileNothing (geMaybe x) xs
75   ==
76   ListHT.dropWhileNothingRec (geMaybe x) xs
77
78dropWhileNothingBreakJust :: Float -> [Float] -> Bool
79dropWhileNothingBreakJust x xs =
80   snd (ListHT.breakJust (geMaybe x) xs)
81   ==
82   ListHT.dropWhileNothing (geMaybe x) xs
83
84breakJustRemoveEach :: Float -> [Float] -> Bool
85breakJustRemoveEach x xs =
86   ListHT.breakJust (geMaybe x) xs == ListHT.breakJustRemoveEach (geMaybe x) xs
87
88breakJustPartial :: Float -> [Float] -> Bool
89breakJustPartial x xs =
90   ListHT.breakJust (geMaybe x) xs == ListHT.breakJustPartial (geMaybe x) xs
91
92
93sieve :: Eq a => Mod.Positive Int -> [a] -> Bool
94sieve (Mod.Positive n) x =
95   equalLists $
96      (ListHT.sieve    n x) :
97      (ListHT.sieve'   n x) :
98      (ListHT.sieve''  n x) :
99      (ListHT.sieve''' n x) :
100      []
101
102
103sliceHorizontal :: Eq a => [a] -> Property
104sliceHorizontal x =
105   QC.forAll (QC.choose (1,1000)) $ \n ->
106      ListHT.sliceHorizontal n x == ListHT.sliceHorizontal' n x
107
108
109sliceVertical :: Eq a => Mod.Positive Int -> [a] -> Bool
110sliceVertical (Mod.Positive n) x =
111   ListHT.sliceVertical n x == ListHT.sliceVertical' n x
112
113slice :: Eq a => Mod.NonEmptyList a -> Property
114slice (Mod.NonEmpty x) =
115   QC.forAll (QC.choose (1, length x)) $ \n ->
116      -- problems: ListHT.sliceHorizontal 4 [] == [[],[],[],[]]
117      ListHT.sliceHorizontal n x == List.transpose (ListHT.sliceVertical  n x)  &&
118      ListHT.sliceVertical  n x == List.transpose (ListHT.sliceHorizontal n x)
119
120
121
122
123shear :: Eq a => [[a]] -> Bool
124shear xs =
125   ListHT.shearTranspose xs  ==  map reverse (ListHT.shear xs)
126
127
128
129outerProduct :: (Eq a, Eq b) => [a] -> [b] -> Bool
130outerProduct xs ys =
131   concat (ListHT.outerProduct (,) xs ys)  ==  liftM2 (,) xs ys
132
133
134lengthAtLeast :: Int -> [a] -> Bool
135lengthAtLeast n xs =
136   ListHT.lengthAtLeast n xs  ==  (length xs >= n)
137
138lengthAtMost :: Int -> [a] -> Bool
139lengthAtMost n xs =
140   ListHT.lengthAtMost n xs  ==  (length xs <= n)
141
142lengthAtMost0 :: Int -> [a] -> Bool
143lengthAtMost0 n xs =
144   ListHT.lengthAtMost0 n xs  ==  (length xs <= n)
145
146
147iterate :: Eq a => (a -> a -> a) -> a -> Bool
148iterate op a =
149   let xs = List.iterate (op a) a
150       ys = ListHT.iterateAssociative op a
151       zs = ListHT.iterateLeaky op a
152   in  equalInfLists 1000 [xs, ys, zs]
153
154
155mapAdjacent :: (Num a, Eq a) => a -> [a] -> Bool
156mapAdjacent x xs =
157   ListHT.mapAdjacent subtract (scanl (+) x xs) == xs
158
159mapAdjacentPointfree :: (Num a, Eq a) => [a] -> Bool
160mapAdjacentPointfree xs =
161   ListHT.mapAdjacent (+) xs == ListHT.mapAdjacentPointfree (+) xs
162
163
164simple ::
165   (Show int, Arbitrary int, Testable test) =>
166   (int -> [Integer] -> test) -> IO ()
167simple = quickCheck
168
169elemCheck ::
170   (Testable test) =>
171   (Float -> [Float] -> test) -> IO ()
172elemCheck = quickCheck
173
174
175tests :: [(String, IO ())]
176tests =
177   ("takeWhileRev0",    elemCheck (\a -> takeWhileRev0 (a>=))) :
178   ("takeWhileRev1",    elemCheck (\a -> takeWhileRev1 (a>=))) :
179   ("takeWhileRev2",    elemCheck (\a -> takeWhileRev2 (a>=))) :
180   ("dropWhileRev",     elemCheck (\a -> dropWhileRev (a>=))) :
181   ("takeRev",          simple takeRev) :
182   ("dropRev",          simple dropRev) :
183   ("splitAtRev",       simple splitAtRev) :
184   ("breakAfterAppend", elemCheck (\a -> breakAfterAppend (a>=))) :
185   ("breakAfter0",      elemCheck (\a -> breakAfter0 (a>=))) :
186   ("breakAfter1",      elemCheck (\a -> breakAfter1 (a>=))) :
187   ("breakAfter2",      elemCheck (\a -> breakAfter2 (a>=))) :
188   ("breakAfterUntil",  elemCheck (\a -> breakAfterUntil (a>=))) :
189   ("dropWhileNothing", elemCheck dropWhileNothing) :
190   ("dropWhileNothingBreakJust",
191                        elemCheck dropWhileNothingBreakJust) :
192   ("breakJustRemoveEach",
193                        elemCheck breakJustRemoveEach) :
194   ("breakJustPartial", elemCheck breakJustPartial) :
195   ("sieve",            simple sieve) :
196   ("sliceHorizontal",  quickCheck (sliceHorizontal :: String -> Property)) :
197   ("sliceVertical",    simple sliceVertical) :
198   ("slice",            quickCheck (slice :: Mod.NonEmptyList Char -> Property)) :
199   ("shear",            quickCheck (shear           :: [[Integer]] -> Bool)) :
200   ("outerProduct",     quickCheck (outerProduct    :: [Integer] -> [Int] -> Bool)) :
201   ("lengthAtLeast",    simple lengthAtLeast) :
202   ("lengthAtMost",     simple lengthAtMost) :
203   ("lengthAtMost0",    simple lengthAtMost0) :
204   ("iterate",          quickCheck (iterate (+)     :: Integer -> Bool)) :
205   ("mapAdjacent",      quickCheck (mapAdjacent     :: Integer -> [Integer] -> Bool)) :
206   ("mapAdjacentPointfree",
207                        quickCheck (mapAdjacentPointfree :: [Integer] -> Bool)) :
208   []
209