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