1{-# LANGUAGE ConstraintKinds #-} 2module Tests.Vector.Property 3 ( CommonContext 4 , VanillaContext 5 , VectorContext 6 , testSanity 7 , testPolymorphicFunctions 8 , testTuplyFunctions 9 , testOrdFunctions 10 , testEnumFunctions 11 , testMonoidFunctions 12 , testFunctorFunctions 13 , testMonadFunctions 14 , testApplicativeFunctions 15 , testAlternativeFunctions 16 , testBoolFunctions 17 , testNumFunctions 18 , testNestedVectorFunctions 19 , testDataFunctions 20 -- re-exports 21 , Data 22 , Random 23 ,Test 24 ) where 25 26import Boilerplater 27import Utilities as Util hiding (limitUnfolds) 28 29import Data.Functor.Identity 30import qualified Data.Traversable as T (Traversable(..)) 31import Data.Foldable (Foldable(foldMap)) 32import Data.Orphans () 33 34import qualified Data.Vector.Generic as V 35import qualified Data.Vector.Fusion.Bundle as S 36 37import Test.QuickCheck 38 39import Test.Tasty 40import Test.Tasty.QuickCheck hiding (testProperties) 41 42import Text.Show.Functions () 43import Data.List 44 45import Data.Monoid 46 47import qualified Control.Applicative as Applicative 48import System.Random (Random) 49 50import Data.Functor.Identity 51import Control.Monad.Trans.Writer 52 53import Control.Monad.Zip 54 55import Data.Data 56 57import qualified Data.List.NonEmpty as DLE 58import Data.Semigroup (Semigroup(..)) 59 60type CommonContext a v = (VanillaContext a, VectorContext a v) 61type VanillaContext a = ( Eq a , Show a, Arbitrary a, CoArbitrary a 62 , TestData a, Model a ~ a, EqTest a ~ Property) 63type VectorContext a v = ( Eq (v a), Show (v a), Arbitrary (v a), CoArbitrary (v a) 64 , TestData (v a), Model (v a) ~ [a], EqTest (v a) ~ Property, V.Vector v a) 65 66-- | migration hack for moving from TestFramework to Tasty 67type Test = TestTree 68-- TODO: implement Vector equivalents of list functions for some of the commented out properties 69 70-- TODO: test and implement some of these other Prelude functions: 71-- mapM * 72-- mapM_ * 73-- sequence 74-- sequence_ 75-- sum * 76-- product * 77-- scanl * 78-- scanl1 * 79-- scanr * 80-- scanr1 * 81-- lookup * 82-- lines 83-- words 84-- unlines 85-- unwords 86-- NB: this is an exhaustive list of all Prelude list functions that make sense for vectors. 87-- Ones with *s are the most plausible candidates. 88 89-- TODO: add tests for the other extra functions 90-- IVector exports still needing tests: 91-- copy, 92-- slice, 93-- (//), update, bpermute, 94-- prescanl, prescanl', 95-- new, 96-- unsafeSlice, unsafeIndex, 97-- vlength, vnew 98 99-- TODO: test non-IVector stuff? 100 101testSanity :: forall a v. (CommonContext a v) => v a -> [Test] 102{-# INLINE testSanity #-} 103testSanity _ = [ 104 testProperty "fromList.toList == id" prop_fromList_toList, 105 testProperty "toList.fromList == id" prop_toList_fromList, 106 testProperty "unstream.stream == id" prop_unstream_stream, 107 testProperty "stream.unstream == id" prop_stream_unstream 108 ] 109 where 110 prop_fromList_toList (v :: v a) = (V.fromList . V.toList) v == v 111 prop_toList_fromList (l :: [a]) = ((V.toList :: v a -> [a]) . V.fromList) l == l 112 prop_unstream_stream (v :: v a) = (V.unstream . V.stream) v == v 113 prop_stream_unstream (s :: S.Bundle v a) = ((V.stream :: v a -> S.Bundle v a) . V.unstream) s == s 114 115testPolymorphicFunctions :: forall a v. (CommonContext a v, VectorContext Int v) => v a -> [Test] 116-- FIXME: inlining of unboxed properties blows up the memory during compilation. See #272 117--{-# INLINE testPolymorphicFunctions #-} 118testPolymorphicFunctions _ = $(testProperties [ 119 'prop_eq, 120 121 -- Length information 122 'prop_length, 'prop_null, 123 124 -- Indexing (FIXME) 125 'prop_index, 'prop_safeIndex, 'prop_head, 'prop_last, 126 'prop_unsafeIndex, 'prop_unsafeHead, 'prop_unsafeLast, 127 128 -- Monadic indexing (FIXME) 129 {- 'prop_indexM, 'prop_headM, 'prop_lastM, 130 'prop_unsafeIndexM, 'prop_unsafeHeadM, 'prop_unsafeLastM, -} 131 132 -- Subvectors (FIXME) 133 'prop_slice, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop, 134 'prop_splitAt, 135 {- 'prop_unsafeSlice, 'prop_unsafeInit, 'prop_unsafeTail, 136 'prop_unsafeTake, 'prop_unsafeDrop, -} 137 138 -- Initialisation (FIXME) 139 'prop_empty, 'prop_singleton, 'prop_replicate, 140 'prop_generate, 'prop_iterateN, 'prop_iterateNM, 141 142 -- Monadic initialisation (FIXME) 143 'prop_createT, 144 {- 'prop_replicateM, 'prop_generateM, 'prop_create, -} 145 146 -- Unfolding 147 'prop_unfoldr, 'prop_unfoldrN, 'prop_unfoldrM, 'prop_unfoldrNM, 148 'prop_constructN, 'prop_constructrN, 149 150 -- Enumeration? (FIXME?) 151 152 -- Concatenation (FIXME) 153 'prop_cons, 'prop_snoc, 'prop_append, 154 'prop_concat, 155 156 -- Restricting memory usage 157 'prop_force, 158 159 160 -- Bulk updates (FIXME) 161 'prop_upd, 162 {- 'prop_update, 'prop_update_, 163 'prop_unsafeUpd, 'prop_unsafeUpdate, 'prop_unsafeUpdate_, -} 164 165 -- Accumulations (FIXME) 166 'prop_accum, 167 {- 'prop_accumulate, 'prop_accumulate_, 168 'prop_unsafeAccum, 'prop_unsafeAccumulate, 'prop_unsafeAccumulate_, -} 169 170 -- Permutations 171 'prop_reverse, 'prop_backpermute, 172 {- 'prop_unsafeBackpermute, -} 173 174 -- Elementwise indexing 175 {- 'prop_indexed, -} 176 177 -- Mapping 178 'prop_map, 'prop_imap, 'prop_concatMap, 179 180 -- Monadic mapping 181 {- 'prop_mapM, 'prop_mapM_, 'prop_forM, 'prop_forM_, -} 182 'prop_imapM, 'prop_imapM_, 183 184 -- Zipping 185 'prop_zipWith, 'prop_zipWith3, {- ... -} 186 'prop_izipWith, 'prop_izipWith3, {- ... -} 187 'prop_izipWithM, 'prop_izipWithM_, 188 {- 'prop_zip, ... -} 189 190 -- Monadic zipping 191 {- 'prop_zipWithM, 'prop_zipWithM_, -} 192 193 -- Unzipping 194 {- 'prop_unzip, ... -} 195 196 -- Filtering 197 'prop_filter, 'prop_ifilter, {- prop_filterM, -} 198 'prop_uniq, 199 'prop_mapMaybe, 'prop_imapMaybe, 200 'prop_takeWhile, 'prop_dropWhile, 201 202 -- Paritioning 203 'prop_partition, {- 'prop_unstablePartition, -} 204 'prop_partitionWith, 205 'prop_span, 'prop_break, 206 207 -- Searching 208 'prop_elem, 'prop_notElem, 209 'prop_find, 'prop_findIndex, 'prop_findIndices, 210 'prop_elemIndex, 'prop_elemIndices, 211 212 -- Folding 213 'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1', 214 'prop_foldr, 'prop_foldr1, 'prop_foldr', 'prop_foldr1', 215 'prop_ifoldl, 'prop_ifoldl', 'prop_ifoldr, 'prop_ifoldr', 216 'prop_ifoldM, 'prop_ifoldM', 'prop_ifoldM_, 'prop_ifoldM'_, 217 218 -- Specialised folds 219 'prop_all, 'prop_any, 220 {- 'prop_maximumBy, 'prop_minimumBy, 221 'prop_maxIndexBy, 'prop_minIndexBy, -} 222 223 -- Monadic folds 224 {- ... -} 225 226 -- Monadic sequencing 227 {- ... -} 228 229 -- Scans 230 'prop_prescanl, 'prop_prescanl', 231 'prop_postscanl, 'prop_postscanl', 232 'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1', 233 'prop_iscanl, 'prop_iscanl', 234 235 'prop_prescanr, 'prop_prescanr', 236 'prop_postscanr, 'prop_postscanr', 237 'prop_scanr, 'prop_scanr', 'prop_scanr1, 'prop_scanr1', 238 'prop_iscanr, 'prop_iscanr' 239 ]) 240 where 241 -- Prelude 242 prop_eq :: P (v a -> v a -> Bool) = (==) `eq` (==) 243 244 prop_length :: P (v a -> Int) = V.length `eq` length 245 prop_null :: P (v a -> Bool) = V.null `eq` null 246 247 prop_empty :: P (v a) = V.empty `eq` [] 248 prop_singleton :: P (a -> v a) = V.singleton `eq` singleton 249 prop_replicate :: P (Int -> a -> v a) 250 = (\n _ -> n < 1000) ===> V.replicate `eq` replicate 251 prop_cons :: P (a -> v a -> v a) = V.cons `eq` (:) 252 prop_snoc :: P (v a -> a -> v a) = V.snoc `eq` snoc 253 prop_append :: P (v a -> v a -> v a) = (V.++) `eq` (++) 254 prop_concat :: P ([v a] -> v a) = V.concat `eq` concat 255 prop_force :: P (v a -> v a) = V.force `eq` id 256 prop_generate :: P (Int -> (Int -> a) -> v a) 257 = (\n _ -> n < 1000) ===> V.generate `eq` Util.generate 258 prop_iterateN :: P (Int -> (a -> a) -> a -> v a) 259 = (\n _ _ -> n < 1000) ===> V.iterateN `eq` (\n f -> take n . iterate f) 260 prop_iterateNM :: P (Int -> (a -> Writer [Int] a) -> a -> Writer [Int] (v a)) 261 = (\n _ _ -> n < 1000) ===> V.iterateNM `eq` Util.iterateNM 262 prop_createT :: P ((a, v a) -> (a, v a)) 263 prop_createT = (\v -> V.createT (T.mapM V.thaw v)) `eq` id 264 265 prop_head :: P (v a -> a) = not . V.null ===> V.head `eq` head 266 prop_last :: P (v a -> a) = not . V.null ===> V.last `eq` last 267 prop_index = \xs -> 268 not (V.null xs) ==> 269 forAll (choose (0, V.length xs-1)) $ \i -> 270 unP prop xs i 271 where 272 prop :: P (v a -> Int -> a) = (V.!) `eq` (!!) 273 prop_safeIndex :: P (v a -> Int -> Maybe a) = (V.!?) `eq` fn 274 where 275 fn xs i = case drop i xs of 276 x:_ | i >= 0 -> Just x 277 _ -> Nothing 278 prop_unsafeHead :: P (v a -> a) = not . V.null ===> V.unsafeHead `eq` head 279 prop_unsafeLast :: P (v a -> a) = not . V.null ===> V.unsafeLast `eq` last 280 prop_unsafeIndex = \xs -> 281 not (V.null xs) ==> 282 forAll (choose (0, V.length xs-1)) $ \i -> 283 unP prop xs i 284 where 285 prop :: P (v a -> Int -> a) = V.unsafeIndex `eq` (!!) 286 287 prop_slice = \xs -> 288 forAll (choose (0, V.length xs)) $ \i -> 289 forAll (choose (0, V.length xs - i)) $ \n -> 290 unP prop i n xs 291 where 292 prop :: P (Int -> Int -> v a -> v a) = V.slice `eq` slice 293 294 prop_tail :: P (v a -> v a) = not . V.null ===> V.tail `eq` tail 295 prop_init :: P (v a -> v a) = not . V.null ===> V.init `eq` init 296 prop_take :: P (Int -> v a -> v a) = V.take `eq` take 297 prop_drop :: P (Int -> v a -> v a) = V.drop `eq` drop 298 prop_splitAt :: P (Int -> v a -> (v a, v a)) = V.splitAt `eq` splitAt 299 300 prop_accum = \f xs -> 301 forAll (index_value_pairs (V.length xs)) $ \ps -> 302 unP prop f xs ps 303 where 304 prop :: P ((a -> a -> a) -> v a -> [(Int,a)] -> v a) 305 = V.accum `eq` accum 306 307 prop_upd = \xs -> 308 forAll (index_value_pairs (V.length xs)) $ \ps -> 309 unP prop xs ps 310 where 311 prop :: P (v a -> [(Int,a)] -> v a) = (V.//) `eq` (//) 312 313 prop_backpermute = \xs -> 314 forAll (indices (V.length xs)) $ \is -> 315 unP prop xs (V.fromList is) 316 where 317 prop :: P (v a -> v Int -> v a) = V.backpermute `eq` backpermute 318 319 prop_reverse :: P (v a -> v a) = V.reverse `eq` reverse 320 321 prop_map :: P ((a -> a) -> v a -> v a) = V.map `eq` map 322 prop_zipWith :: P ((a -> a -> a) -> v a -> v a -> v a) = V.zipWith `eq` zipWith 323 prop_zipWith3 :: P ((a -> a -> a -> a) -> v a -> v a -> v a -> v a) 324 = V.zipWith3 `eq` zipWith3 325 prop_imap :: P ((Int -> a -> a) -> v a -> v a) = V.imap `eq` imap 326 prop_imapM :: P ((Int -> a -> Identity a) -> v a -> Identity (v a)) 327 = V.imapM `eq` imapM 328 prop_imapM_ :: P ((Int -> a -> Writer [a] ()) -> v a -> Writer [a] ()) 329 = V.imapM_ `eq` imapM_ 330 prop_izipWith :: P ((Int -> a -> a -> a) -> v a -> v a -> v a) = V.izipWith `eq` izipWith 331 prop_izipWithM :: P ((Int -> a -> a -> Identity a) -> v a -> v a -> Identity (v a)) 332 = V.izipWithM `eq` izipWithM 333 prop_izipWithM_ :: P ((Int -> a -> a -> Writer [a] ()) -> v a -> v a -> Writer [a] ()) 334 = V.izipWithM_ `eq` izipWithM_ 335 prop_izipWith3 :: P ((Int -> a -> a -> a -> a) -> v a -> v a -> v a -> v a) 336 = V.izipWith3 `eq` izipWith3 337 338 prop_filter :: P ((a -> Bool) -> v a -> v a) = V.filter `eq` filter 339 prop_ifilter :: P ((Int -> a -> Bool) -> v a -> v a) = V.ifilter `eq` ifilter 340 prop_mapMaybe :: P ((a -> Maybe a) -> v a -> v a) = V.mapMaybe `eq` mapMaybe 341 prop_imapMaybe :: P ((Int -> a -> Maybe a) -> v a -> v a) = V.imapMaybe `eq` imapMaybe 342 prop_takeWhile :: P ((a -> Bool) -> v a -> v a) = V.takeWhile `eq` takeWhile 343 prop_dropWhile :: P ((a -> Bool) -> v a -> v a) = V.dropWhile `eq` dropWhile 344 prop_partition :: P ((a -> Bool) -> v a -> (v a, v a)) 345 = V.partition `eq` partition 346 prop_partitionWith :: P ((a -> Either a a) -> v a -> (v a, v a)) 347 = V.partitionWith `eq` partitionWith 348 prop_span :: P ((a -> Bool) -> v a -> (v a, v a)) = V.span `eq` span 349 prop_break :: P ((a -> Bool) -> v a -> (v a, v a)) = V.break `eq` break 350 351 prop_elem :: P (a -> v a -> Bool) = V.elem `eq` elem 352 prop_notElem :: P (a -> v a -> Bool) = V.notElem `eq` notElem 353 prop_find :: P ((a -> Bool) -> v a -> Maybe a) = V.find `eq` find 354 prop_findIndex :: P ((a -> Bool) -> v a -> Maybe Int) 355 = V.findIndex `eq` findIndex 356 prop_findIndices :: P ((a -> Bool) -> v a -> v Int) 357 = V.findIndices `eq` findIndices 358 prop_elemIndex :: P (a -> v a -> Maybe Int) = V.elemIndex `eq` elemIndex 359 prop_elemIndices :: P (a -> v a -> v Int) = V.elemIndices `eq` elemIndices 360 361 prop_foldl :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl `eq` foldl 362 prop_foldl1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> 363 V.foldl1 `eq` foldl1 364 prop_foldl' :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl' `eq` foldl' 365 prop_foldl1' :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> 366 V.foldl1' `eq` foldl1' 367 prop_foldr :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr `eq` foldr 368 prop_foldr1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> 369 V.foldr1 `eq` foldr1 370 prop_foldr' :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr' `eq` foldr 371 prop_foldr1' :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> 372 V.foldr1' `eq` foldr1 373 prop_ifoldl :: P ((a -> Int -> a -> a) -> a -> v a -> a) 374 = V.ifoldl `eq` ifoldl 375 prop_ifoldl' :: P ((a -> Int -> a -> a) -> a -> v a -> a) 376 = V.ifoldl' `eq` ifoldl 377 prop_ifoldr :: P ((Int -> a -> a -> a) -> a -> v a -> a) 378 = V.ifoldr `eq` ifoldr 379 prop_ifoldr' :: P ((Int -> a -> a -> a) -> a -> v a -> a) 380 = V.ifoldr' `eq` ifoldr 381 prop_ifoldM :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a) 382 = V.ifoldM `eq` ifoldM 383 prop_ifoldM' :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a) 384 = V.ifoldM' `eq` ifoldM 385 prop_ifoldM_ :: P ((() -> Int -> a -> Writer [a] ()) -> () -> v a -> Writer [a] ()) 386 = V.ifoldM_ `eq` ifoldM_ 387 prop_ifoldM'_ :: P ((() -> Int -> a -> Writer [a] ()) -> () -> v a -> Writer [a] ()) 388 = V.ifoldM'_ `eq` ifoldM_ 389 390 prop_all :: P ((a -> Bool) -> v a -> Bool) = V.all `eq` all 391 prop_any :: P ((a -> Bool) -> v a -> Bool) = V.any `eq` any 392 393 prop_prescanl :: P ((a -> a -> a) -> a -> v a -> v a) 394 = V.prescanl `eq` prescanl 395 prop_prescanl' :: P ((a -> a -> a) -> a -> v a -> v a) 396 = V.prescanl' `eq` prescanl 397 prop_postscanl :: P ((a -> a -> a) -> a -> v a -> v a) 398 = V.postscanl `eq` postscanl 399 prop_postscanl' :: P ((a -> a -> a) -> a -> v a -> v a) 400 = V.postscanl' `eq` postscanl 401 prop_scanl :: P ((a -> a -> a) -> a -> v a -> v a) 402 = V.scanl `eq` scanl 403 prop_scanl' :: P ((a -> a -> a) -> a -> v a -> v a) 404 = V.scanl' `eq` scanl 405 prop_scanl1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> 406 V.scanl1 `eq` scanl1 407 prop_scanl1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> 408 V.scanl1' `eq` scanl1 409 prop_iscanl :: P ((Int -> a -> a -> a) -> a -> v a -> v a) 410 = V.iscanl `eq` iscanl 411 prop_iscanl' :: P ((Int -> a -> a -> a) -> a -> v a -> v a) 412 = V.iscanl' `eq` iscanl 413 414 prop_prescanr :: P ((a -> a -> a) -> a -> v a -> v a) 415 = V.prescanr `eq` prescanr 416 prop_prescanr' :: P ((a -> a -> a) -> a -> v a -> v a) 417 = V.prescanr' `eq` prescanr 418 prop_postscanr :: P ((a -> a -> a) -> a -> v a -> v a) 419 = V.postscanr `eq` postscanr 420 prop_postscanr' :: P ((a -> a -> a) -> a -> v a -> v a) 421 = V.postscanr' `eq` postscanr 422 prop_scanr :: P ((a -> a -> a) -> a -> v a -> v a) 423 = V.scanr `eq` scanr 424 prop_scanr' :: P ((a -> a -> a) -> a -> v a -> v a) 425 = V.scanr' `eq` scanr 426 prop_iscanr :: P ((Int -> a -> a -> a) -> a -> v a -> v a) 427 = V.iscanr `eq` iscanr 428 prop_iscanr' :: P ((Int -> a -> a -> a) -> a -> v a -> v a) 429 = V.iscanr' `eq` iscanr 430 prop_scanr1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> 431 V.scanr1 `eq` scanr1 432 prop_scanr1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> 433 V.scanr1' `eq` scanr1 434 435 prop_concatMap = forAll arbitrary $ \xs -> 436 forAll (sized (\n -> resize (n `div` V.length xs) arbitrary)) $ \f -> unP prop f xs 437 where 438 prop :: P ((a -> v a) -> v a -> v a) = V.concatMap `eq` concatMap 439 440 prop_uniq :: P (v a -> v a) 441 = V.uniq `eq` (map head . group) 442 --prop_span = (V.span :: (a -> Bool) -> v a -> (v a, v a)) `eq2` span 443 --prop_break = (V.break :: (a -> Bool) -> v a -> (v a, v a)) `eq2` break 444 --prop_splitAt = (V.splitAt :: Int -> v a -> (v a, v a)) `eq2` splitAt 445 --prop_all = (V.all :: (a -> Bool) -> v a -> Bool) `eq2` all 446 --prop_any = (V.any :: (a -> Bool) -> v a -> Bool) `eq2` any 447 448 -- Data.List 449 --prop_findIndices = V.findIndices `eq2` (findIndices :: (a -> Bool) -> v a -> v Int) 450 --prop_isPrefixOf = V.isPrefixOf `eq2` (isPrefixOf :: v a -> v a -> Bool) 451 --prop_elemIndex = V.elemIndex `eq2` (elemIndex :: a -> v a -> Maybe Int) 452 --prop_elemIndices = V.elemIndices `eq2` (elemIndices :: a -> v a -> v Int) 453 -- 454 --prop_mapAccumL = eq3 455 -- (V.mapAccumL :: (X -> W -> (X,W)) -> X -> B -> (X, B)) 456 -- ( mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W])) 457 -- 458 --prop_mapAccumR = eq3 459 -- (V.mapAccumR :: (X -> W -> (X,W)) -> X -> B -> (X, B)) 460 -- ( mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W])) 461 462 -- Because the vectors are strict, we need to be totally sure that the unfold eventually terminates. This 463 -- is achieved by injecting our own bit of state into the unfold - the maximum number of unfolds allowed. 464 limitUnfolds f (theirs, ours) 465 | ours > 0 466 , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1)) 467 | otherwise = Nothing 468 limitUnfoldsM f (theirs, ours) 469 | ours > 0 = do r <- f theirs 470 return $ (\(a,b) -> (a,(b,ours - 1))) `fmap` r 471 | otherwise = return Nothing 472 473 474 prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a) 475 = (\n f a -> V.unfoldr (limitUnfolds f) (a, n)) 476 `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n)) 477 prop_unfoldrN :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a) 478 = V.unfoldrN `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n)) 479 prop_unfoldrM :: P (Int -> (Int -> Writer [Int] (Maybe (a,Int))) -> Int -> Writer [Int] (v a)) 480 = (\n f a -> V.unfoldrM (limitUnfoldsM f) (a,n)) 481 `eq` (\n f a -> Util.unfoldrM (limitUnfoldsM f) (a, n)) 482 prop_unfoldrNM :: P (Int -> (Int -> Writer [Int] (Maybe (a,Int))) -> Int -> Writer [Int] (v a)) 483 = V.unfoldrNM `eq` (\n f a -> Util.unfoldrM (limitUnfoldsM f) (a, n)) 484 485 prop_constructN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f 486 where 487 prop :: P (Int -> (v a -> a) -> v a) = V.constructN `eq` constructN [] 488 489 constructN xs 0 _ = xs 490 constructN xs n f = constructN (xs ++ [f xs]) (n-1) f 491 492 prop_constructrN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f 493 where 494 prop :: P (Int -> (v a -> a) -> v a) = V.constructrN `eq` constructrN [] 495 496 constructrN xs 0 _ = xs 497 constructrN xs n f = constructrN (f xs : xs) (n-1) f 498 499-- copied from GHC source code 500partitionWith :: (a -> Either b c) -> [a] -> ([b], [c]) 501partitionWith _ [] = ([],[]) 502partitionWith f (x:xs) = case f x of 503 Left b -> (b:bs, cs) 504 Right c -> (bs, c:cs) 505 where (bs,cs) = partitionWith f xs 506 507testTuplyFunctions :: forall a v. (CommonContext a v, VectorContext (a, a) v, VectorContext (a, a, a) v) => v a -> [Test] 508{-# INLINE testTuplyFunctions #-} 509testTuplyFunctions _ = $(testProperties [ 'prop_zip, 'prop_zip3 510 , 'prop_unzip, 'prop_unzip3 511 ]) 512 where 513 prop_zip :: P (v a -> v a -> v (a, a)) = V.zip `eq` zip 514 prop_zip3 :: P (v a -> v a -> v a -> v (a, a, a)) = V.zip3 `eq` zip3 515 prop_unzip :: P (v (a, a) -> (v a, v a)) = V.unzip `eq` unzip 516 prop_unzip3 :: P (v (a, a, a) -> (v a, v a, v a)) = V.unzip3 `eq` unzip3 517 518testOrdFunctions :: forall a v. (CommonContext a v, Ord a, Ord (v a)) => v a -> [Test] 519{-# INLINE testOrdFunctions #-} 520testOrdFunctions _ = $(testProperties 521 ['prop_compare, 522 'prop_maximum, 'prop_minimum, 523 'prop_minIndex, 'prop_maxIndex, 524 'prop_maximumBy, 'prop_minimumBy, 525 'prop_maxIndexBy, 'prop_minIndexBy, 526 'prop_ListLastMaxIndexWins, 'prop_FalseListFirstMaxIndexWins ]) 527 where 528 prop_compare :: P (v a -> v a -> Ordering) = compare `eq` compare 529 prop_maximum :: P (v a -> a) = not . V.null ===> V.maximum `eq` maximum 530 prop_minimum :: P (v a -> a) = not . V.null ===> V.minimum `eq` minimum 531 prop_minIndex :: P (v a -> Int) = not . V.null ===> V.minIndex `eq` minIndex 532 prop_maxIndex :: P (v a -> Int) = not . V.null ===> V.maxIndex `eq` listMaxIndexFMW 533 prop_maximumBy :: P (v a -> a) = 534 not . V.null ===> V.maximumBy compare `eq` maximum 535 prop_minimumBy :: P (v a -> a) = 536 not . V.null ===> V.minimumBy compare `eq` minimum 537 prop_maxIndexBy :: P (v a -> Int) = 538 not . V.null ===> V.maxIndexBy compare `eq` listMaxIndexFMW 539 --- (maxIndex) 540 prop_ListLastMaxIndexWins :: P (v a -> Int) = 541 not . V.null ===> ( maxIndex . V.toList) `eq` listMaxIndexLMW 542 prop_FalseListFirstMaxIndexWinsDesc :: P (v a -> Int) = 543 (\x -> not $ V.null x && (V.uniq x /= x ) )===> ( maxIndex . V.toList) `eq` listMaxIndexFMW 544 prop_FalseListFirstMaxIndexWins :: Property 545 prop_FalseListFirstMaxIndexWins = expectFailure prop_FalseListFirstMaxIndexWinsDesc 546 prop_minIndexBy :: P (v a -> Int) = 547 not . V.null ===> V.minIndexBy compare `eq` minIndex 548 549listMaxIndexFMW :: Ord a => [a] -> Int 550listMaxIndexFMW = ( fst . extractFMW . sconcat . DLE.fromList . fmap FMW . zip [0 :: Int ..]) 551 552listMaxIndexLMW :: Ord a => [a] -> Int 553listMaxIndexLMW = ( fst . extractLMW . sconcat . DLE.fromList . fmap LMW . zip [0 :: Int ..]) 554 555newtype LastMaxWith a i = LMW {extractLMW:: (i,a)} 556 deriving(Eq,Show,Read) 557instance (Ord a) => Semigroup (LastMaxWith a i) where 558 (<>) x y | snd (extractLMW x) > snd (extractLMW y) = x 559 | snd (extractLMW x) < snd (extractLMW y) = y 560 | otherwise = y 561newtype FirstMaxWith a i = FMW {extractFMW:: (i,a)} 562 deriving(Eq,Show,Read) 563instance (Ord a) => Semigroup (FirstMaxWith a i) where 564 (<>) x y | snd (extractFMW x) > snd (extractFMW y) = x 565 | snd (extractFMW x) < snd (extractFMW y) = y 566 | otherwise = x 567 568 569testEnumFunctions :: forall a v. (CommonContext a v, Enum a, Ord a, Num a, Random a) => v a -> [Test] 570{-# INLINE testEnumFunctions #-} 571testEnumFunctions _ = $(testProperties 572 [ 'prop_enumFromN, 'prop_enumFromThenN, 573 'prop_enumFromTo, 'prop_enumFromThenTo]) 574 where 575 prop_enumFromN :: P (a -> Int -> v a) 576 = (\_ n -> n < 1000) 577 ===> V.enumFromN `eq` (\x n -> take n $ scanl (+) x $ repeat 1) 578 579 prop_enumFromThenN :: P (a -> a -> Int -> v a) 580 = (\_ _ n -> n < 1000) 581 ===> V.enumFromStepN `eq` (\x y n -> take n $ scanl (+) x $ repeat y) 582 583 prop_enumFromTo = \m -> 584 forAll (choose (-2,100)) $ \n -> 585 unP prop m (m+n) 586 where 587 prop :: P (a -> a -> v a) = V.enumFromTo `eq` enumFromTo 588 589 prop_enumFromThenTo = \i j -> 590 j /= i ==> 591 forAll (choose (ks i j)) $ \k -> 592 unP prop i j k 593 where 594 prop :: P (a -> a -> a -> v a) = V.enumFromThenTo `eq` enumFromThenTo 595 596 ks i j | j < i = (i-d*100, i+d*2) 597 | otherwise = (i-d*2, i+d*100) 598 where 599 d = abs (j-i) 600 601testMonoidFunctions :: forall a v. (CommonContext a v, Monoid (v a)) => v a -> [Test] 602{-# INLINE testMonoidFunctions #-} 603testMonoidFunctions _ = $(testProperties 604 [ 'prop_mempty, 'prop_mappend, 'prop_mconcat ]) 605 where 606 prop_mempty :: P (v a) = mempty `eq` mempty 607 prop_mappend :: P (v a -> v a -> v a) = mappend `eq` mappend 608 prop_mconcat :: P ([v a] -> v a) = mconcat `eq` mconcat 609 610testFunctorFunctions :: forall a v. (CommonContext a v, Functor v) => v a -> [Test] 611{-# INLINE testFunctorFunctions #-} 612testFunctorFunctions _ = $(testProperties 613 [ 'prop_fmap ]) 614 where 615 prop_fmap :: P ((a -> a) -> v a -> v a) = fmap `eq` fmap 616 617testMonadFunctions :: forall a v. (CommonContext a v, VectorContext (a, a) v, MonadZip v) => v a -> [Test] 618{-# INLINE testMonadFunctions #-} 619testMonadFunctions _ = $(testProperties [ 'prop_return, 'prop_bind 620 , 'prop_mzip, 'prop_munzip]) 621 where 622 prop_return :: P (a -> v a) = return `eq` return 623 prop_bind :: P (v a -> (a -> v a) -> v a) = (>>=) `eq` (>>=) 624 prop_mzip :: P (v a -> v a -> v (a, a)) = mzip `eq` zip 625 prop_munzip :: P (v (a, a) -> (v a, v a)) = munzip `eq` unzip 626 627testApplicativeFunctions :: forall a v. (CommonContext a v, V.Vector v (a -> a), Applicative.Applicative v) => v a -> [Test] 628{-# INLINE testApplicativeFunctions #-} 629testApplicativeFunctions _ = $(testProperties 630 [ 'prop_applicative_pure, 'prop_applicative_appl ]) 631 where 632 prop_applicative_pure :: P (a -> v a) 633 = Applicative.pure `eq` Applicative.pure 634 prop_applicative_appl :: [a -> a] -> P (v a -> v a) 635 = \fs -> (Applicative.<*>) (V.fromList fs) `eq` (Applicative.<*>) fs 636 637testAlternativeFunctions :: forall a v. (CommonContext a v, Applicative.Alternative v) => v a -> [Test] 638{-# INLINE testAlternativeFunctions #-} 639testAlternativeFunctions _ = $(testProperties 640 [ 'prop_alternative_empty, 'prop_alternative_or ]) 641 where 642 prop_alternative_empty :: P (v a) = Applicative.empty `eq` Applicative.empty 643 prop_alternative_or :: P (v a -> v a -> v a) 644 = (Applicative.<|>) `eq` (Applicative.<|>) 645 646testBoolFunctions :: forall v. (CommonContext Bool v) => v Bool -> [Test] 647{-# INLINE testBoolFunctions #-} 648testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or]) 649 where 650 prop_and :: P (v Bool -> Bool) = V.and `eq` and 651 prop_or :: P (v Bool -> Bool) = V.or `eq` or 652 653testNumFunctions :: forall a v. (CommonContext a v, Num a) => v a -> [Test] 654{-# INLINE testNumFunctions #-} 655testNumFunctions _ = $(testProperties ['prop_sum, 'prop_product]) 656 where 657 prop_sum :: P (v a -> a) = V.sum `eq` sum 658 prop_product :: P (v a -> a) = V.product `eq` product 659 660testNestedVectorFunctions :: forall a v. (CommonContext a v) => v a -> [Test] 661{-# INLINE testNestedVectorFunctions #-} 662testNestedVectorFunctions _ = $(testProperties []) 663 where 664 -- Prelude 665 --prop_concat = (V.concat :: [v a] -> v a) `eq1` concat 666 667 -- Data.List 668 --prop_transpose = V.transpose `eq1` (transpose :: [v a] -> [v a]) 669 --prop_group = V.group `eq1` (group :: v a -> [v a]) 670 --prop_inits = V.inits `eq1` (inits :: v a -> [v a]) 671 --prop_tails = V.tails `eq1` (tails :: v a -> [v a]) 672 673testDataFunctions :: forall a v. (CommonContext a v, Data a, Data (v a)) => v a -> [Test] 674{-# INLINE testDataFunctions #-} 675testDataFunctions _ = $(testProperties ['prop_glength]) 676 where 677 prop_glength :: P (v a -> Int) = glength `eq` glength 678 where 679 glength :: Data b => b -> Int 680 glength xs = gmapQl (+) 0 toA xs 681 682 toA :: Data b => b -> Int 683 toA x = maybe (glength x) (const 1) (cast x :: Maybe a) 684