{-# LANGUAGE ConstraintKinds #-}
module Tests.Vector (tests) where
import Boilerplater
import Utilities as Util
import Data.Functor.Identity
import qualified Data.Traversable as T (Traversable(..))
import Data.Foldable (Foldable(foldMap))
import qualified Data.Vector.Generic as V
import qualified Data.Vector
import qualified Data.Vector.Primitive
import qualified Data.Vector.Storable
import qualified Data.Vector.Unboxed
import qualified Data.Vector.Fusion.Bundle as S
import Test.QuickCheck
import Test.Framework
import Test.Framework.Providers.QuickCheck2
import Text.Show.Functions ()
import Data.List
import Data.Monoid
import qualified Control.Applicative as Applicative
import System.Random (Random)
import Data.Functor.Identity
import Control.Monad.Trans.Writer
import Control.Monad.Zip
type CommonContext a v = (VanillaContext a, VectorContext a v)
type VanillaContext a = ( Eq a , Show a, Arbitrary a, CoArbitrary a
, TestData a, Model a ~ a, EqTest a ~ Property)
type VectorContext a v = ( Eq (v a), Show (v a), Arbitrary (v a), CoArbitrary (v a)
, TestData (v a), Model (v a) ~ [a], EqTest (v a) ~ Property, V.Vector v a)
-- TODO: implement Vector equivalents of list functions for some of the commented out properties
-- TODO: test and implement some of these other Prelude functions:
-- mapM *
-- mapM_ *
-- sequence
-- sequence_
-- sum *
-- product *
-- scanl *
-- scanl1 *
-- scanr *
-- scanr1 *
-- lookup *
-- lines
-- words
-- unlines
-- unwords
-- NB: this is an exhaustive list of all Prelude list functions that make sense for vectors.
-- Ones with *s are the most plausible candidates.
-- TODO: add tests for the other extra functions
-- IVector exports still needing tests:
-- copy,
-- slice,
-- (//), update, bpermute,
-- prescanl, prescanl',
-- new,
-- unsafeSlice, unsafeIndex,
-- vlength, vnew
-- TODO: test non-IVector stuff?
#if !MIN_VERSION_base(4,7,0)
instance Foldable ((,) a) where
foldMap f (_, b) = f b
instance T.Traversable ((,) a) where
traverse f (a, b) = fmap ((,) a) $ f b
#endif
testSanity :: forall a v. (CommonContext a v) => v a -> [Test]
testSanity _ = [
testProperty "fromList.toList == id" prop_fromList_toList,
testProperty "toList.fromList == id" prop_toList_fromList,
testProperty "unstream.stream == id" prop_unstream_stream,
testProperty "stream.unstream == id" prop_stream_unstream
]
where
prop_fromList_toList (v :: v a) = (V.fromList . V.toList) v == v
prop_toList_fromList (l :: [a]) = ((V.toList :: v a -> [a]) . V.fromList) l == l
prop_unstream_stream (v :: v a) = (V.unstream . V.stream) v == v
prop_stream_unstream (s :: S.Bundle v a) = ((V.stream :: v a -> S.Bundle v a) . V.unstream) s == s
testPolymorphicFunctions :: forall a v. (CommonContext a v, VectorContext Int v) => v a -> [Test]
testPolymorphicFunctions _ = $(testProperties [
'prop_eq,
-- Length information
'prop_length, 'prop_null,
-- Indexing (FIXME)
'prop_index, 'prop_safeIndex, 'prop_head, 'prop_last,
'prop_unsafeIndex, 'prop_unsafeHead, 'prop_unsafeLast,
-- Monadic indexing (FIXME)
{- 'prop_indexM, 'prop_headM, 'prop_lastM,
'prop_unsafeIndexM, 'prop_unsafeHeadM, 'prop_unsafeLastM, -}
-- Subvectors (FIXME)
'prop_slice, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop,
'prop_splitAt,
{- 'prop_unsafeSlice, 'prop_unsafeInit, 'prop_unsafeTail,
'prop_unsafeTake, 'prop_unsafeDrop, -}
-- Initialisation (FIXME)
'prop_empty, 'prop_singleton, 'prop_replicate,
'prop_generate, 'prop_iterateN, 'prop_iterateNM,
-- Monadic initialisation (FIXME)
'prop_createT,
{- 'prop_replicateM, 'prop_generateM, 'prop_create, -}
-- Unfolding
'prop_unfoldr, 'prop_unfoldrN, 'prop_unfoldrM, 'prop_unfoldrNM,
'prop_constructN, 'prop_constructrN,
-- Enumeration? (FIXME?)
-- Concatenation (FIXME)
'prop_cons, 'prop_snoc, 'prop_append,
'prop_concat,
-- Restricting memory usage
'prop_force,
-- Bulk updates (FIXME)
'prop_upd,
{- 'prop_update, 'prop_update_,
'prop_unsafeUpd, 'prop_unsafeUpdate, 'prop_unsafeUpdate_, -}
-- Accumulations (FIXME)
'prop_accum,
{- 'prop_accumulate, 'prop_accumulate_,
'prop_unsafeAccum, 'prop_unsafeAccumulate, 'prop_unsafeAccumulate_, -}
-- Permutations
'prop_reverse, 'prop_backpermute,
{- 'prop_unsafeBackpermute, -}
-- Elementwise indexing
{- 'prop_indexed, -}
-- Mapping
'prop_map, 'prop_imap, 'prop_concatMap,
-- Monadic mapping
{- 'prop_mapM, 'prop_mapM_, 'prop_forM, 'prop_forM_, -}
'prop_imapM, 'prop_imapM_,
-- Zipping
'prop_zipWith, 'prop_zipWith3, {- ... -}
'prop_izipWith, 'prop_izipWith3, {- ... -}
'prop_izipWithM, 'prop_izipWithM_,
{- 'prop_zip, ... -}
-- Monadic zipping
{- 'prop_zipWithM, 'prop_zipWithM_, -}
-- Unzipping
{- 'prop_unzip, ... -}
-- Filtering
'prop_filter, 'prop_ifilter, {- prop_filterM, -}
'prop_uniq,
'prop_mapMaybe, 'prop_imapMaybe,
'prop_takeWhile, 'prop_dropWhile,
-- Paritioning
'prop_partition, {- 'prop_unstablePartition, -}
'prop_span, 'prop_break,
-- Searching
'prop_elem, 'prop_notElem,
'prop_find, 'prop_findIndex, 'prop_findIndices,
'prop_elemIndex, 'prop_elemIndices,
-- Folding
'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1',
'prop_foldr, 'prop_foldr1, 'prop_foldr', 'prop_foldr1',
'prop_ifoldl, 'prop_ifoldl', 'prop_ifoldr, 'prop_ifoldr',
'prop_ifoldM, 'prop_ifoldM', 'prop_ifoldM_, 'prop_ifoldM'_,
-- Specialised folds
'prop_all, 'prop_any,
{- 'prop_maximumBy, 'prop_minimumBy,
'prop_maxIndexBy, 'prop_minIndexBy, -}
-- Monadic folds
{- ... -}
-- Monadic sequencing
{- ... -}
-- Scans
'prop_prescanl, 'prop_prescanl',
'prop_postscanl, 'prop_postscanl',
'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1',
'prop_iscanl, 'prop_iscanl',
'prop_prescanr, 'prop_prescanr',
'prop_postscanr, 'prop_postscanr',
'prop_scanr, 'prop_scanr', 'prop_scanr1, 'prop_scanr1',
'prop_iscanr, 'prop_iscanr'
])
where
-- Prelude
prop_eq :: P (v a -> v a -> Bool) = (==) `eq` (==)
prop_length :: P (v a -> Int) = V.length `eq` length
prop_null :: P (v a -> Bool) = V.null `eq` null
prop_empty :: P (v a) = V.empty `eq` []
prop_singleton :: P (a -> v a) = V.singleton `eq` singleton
prop_replicate :: P (Int -> a -> v a)
= (\n _ -> n < 1000) ===> V.replicate `eq` replicate
prop_cons :: P (a -> v a -> v a) = V.cons `eq` (:)
prop_snoc :: P (v a -> a -> v a) = V.snoc `eq` snoc
prop_append :: P (v a -> v a -> v a) = (V.++) `eq` (++)
prop_concat :: P ([v a] -> v a) = V.concat `eq` concat
prop_force :: P (v a -> v a) = V.force `eq` id
prop_generate :: P (Int -> (Int -> a) -> v a)
= (\n _ -> n < 1000) ===> V.generate `eq` Util.generate
prop_iterateN :: P (Int -> (a -> a) -> a -> v a)
= (\n _ _ -> n < 1000) ===> V.iterateN `eq` (\n f -> take n . iterate f)
prop_iterateNM :: P (Int -> (a -> Writer [Int] a) -> a -> Writer [Int] (v a))
= (\n _ _ -> n < 1000) ===> V.iterateNM `eq` Util.iterateNM
prop_createT :: P ((a, v a) -> (a, v a))
prop_createT = (\v -> V.createT (T.mapM V.thaw v)) `eq` id
prop_head :: P (v a -> a) = not . V.null ===> V.head `eq` head
prop_last :: P (v a -> a) = not . V.null ===> V.last `eq` last
prop_index = \xs ->
not (V.null xs) ==>
forAll (choose (0, V.length xs-1)) $ \i ->
unP prop xs i
where
prop :: P (v a -> Int -> a) = (V.!) `eq` (!!)
prop_safeIndex :: P (v a -> Int -> Maybe a) = (V.!?) `eq` fn
where
fn xs i = case drop i xs of
x:_ | i >= 0 -> Just x
_ -> Nothing
prop_unsafeHead :: P (v a -> a) = not . V.null ===> V.unsafeHead `eq` head
prop_unsafeLast :: P (v a -> a) = not . V.null ===> V.unsafeLast `eq` last
prop_unsafeIndex = \xs ->
not (V.null xs) ==>
forAll (choose (0, V.length xs-1)) $ \i ->
unP prop xs i
where
prop :: P (v a -> Int -> a) = V.unsafeIndex `eq` (!!)
prop_slice = \xs ->
forAll (choose (0, V.length xs)) $ \i ->
forAll (choose (0, V.length xs - i)) $ \n ->
unP prop i n xs
where
prop :: P (Int -> Int -> v a -> v a) = V.slice `eq` slice
prop_tail :: P (v a -> v a) = not . V.null ===> V.tail `eq` tail
prop_init :: P (v a -> v a) = not . V.null ===> V.init `eq` init
prop_take :: P (Int -> v a -> v a) = V.take `eq` take
prop_drop :: P (Int -> v a -> v a) = V.drop `eq` drop
prop_splitAt :: P (Int -> v a -> (v a, v a)) = V.splitAt `eq` splitAt
prop_accum = \f xs ->
forAll (index_value_pairs (V.length xs)) $ \ps ->
unP prop f xs ps
where
prop :: P ((a -> a -> a) -> v a -> [(Int,a)] -> v a)
= V.accum `eq` accum
prop_upd = \xs ->
forAll (index_value_pairs (V.length xs)) $ \ps ->
unP prop xs ps
where
prop :: P (v a -> [(Int,a)] -> v a) = (V.//) `eq` (//)
prop_backpermute = \xs ->
forAll (indices (V.length xs)) $ \is ->
unP prop xs (V.fromList is)
where
prop :: P (v a -> v Int -> v a) = V.backpermute `eq` backpermute
prop_reverse :: P (v a -> v a) = V.reverse `eq` reverse
prop_map :: P ((a -> a) -> v a -> v a) = V.map `eq` map
prop_zipWith :: P ((a -> a -> a) -> v a -> v a -> v a) = V.zipWith `eq` zipWith
prop_zipWith3 :: P ((a -> a -> a -> a) -> v a -> v a -> v a -> v a)
= V.zipWith3 `eq` zipWith3
prop_imap :: P ((Int -> a -> a) -> v a -> v a) = V.imap `eq` imap
prop_imapM :: P ((Int -> a -> Identity a) -> v a -> Identity (v a))
= V.imapM `eq` imapM
prop_imapM_ :: P ((Int -> a -> Writer [a] ()) -> v a -> Writer [a] ())
= V.imapM_ `eq` imapM_
prop_izipWith :: P ((Int -> a -> a -> a) -> v a -> v a -> v a) = V.izipWith `eq` izipWith
prop_izipWithM :: P ((Int -> a -> a -> Identity a) -> v a -> v a -> Identity (v a))
= V.izipWithM `eq` izipWithM
prop_izipWithM_ :: P ((Int -> a -> a -> Writer [a] ()) -> v a -> v a -> Writer [a] ())
= V.izipWithM_ `eq` izipWithM_
prop_izipWith3 :: P ((Int -> a -> a -> a -> a) -> v a -> v a -> v a -> v a)
= V.izipWith3 `eq` izipWith3
prop_filter :: P ((a -> Bool) -> v a -> v a) = V.filter `eq` filter
prop_ifilter :: P ((Int -> a -> Bool) -> v a -> v a) = V.ifilter `eq` ifilter
prop_mapMaybe :: P ((a -> Maybe a) -> v a -> v a) = V.mapMaybe `eq` mapMaybe
prop_imapMaybe :: P ((Int -> a -> Maybe a) -> v a -> v a) = V.imapMaybe `eq` imapMaybe
prop_takeWhile :: P ((a -> Bool) -> v a -> v a) = V.takeWhile `eq` takeWhile
prop_dropWhile :: P ((a -> Bool) -> v a -> v a) = V.dropWhile `eq` dropWhile
prop_partition :: P ((a -> Bool) -> v a -> (v a, v a))
= V.partition `eq` partition
prop_span :: P ((a -> Bool) -> v a -> (v a, v a)) = V.span `eq` span
prop_break :: P ((a -> Bool) -> v a -> (v a, v a)) = V.break `eq` break
prop_elem :: P (a -> v a -> Bool) = V.elem `eq` elem
prop_notElem :: P (a -> v a -> Bool) = V.notElem `eq` notElem
prop_find :: P ((a -> Bool) -> v a -> Maybe a) = V.find `eq` find
prop_findIndex :: P ((a -> Bool) -> v a -> Maybe Int)
= V.findIndex `eq` findIndex
prop_findIndices :: P ((a -> Bool) -> v a -> v Int)
= V.findIndices `eq` findIndices
prop_elemIndex :: P (a -> v a -> Maybe Int) = V.elemIndex `eq` elemIndex
prop_elemIndices :: P (a -> v a -> v Int) = V.elemIndices `eq` elemIndices
prop_foldl :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl `eq` foldl
prop_foldl1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===>
V.foldl1 `eq` foldl1
prop_foldl' :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl' `eq` foldl'
prop_foldl1' :: P ((a -> a -> a) -> v a -> a) = notNull2 ===>
V.foldl1' `eq` foldl1'
prop_foldr :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr `eq` foldr
prop_foldr1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===>
V.foldr1 `eq` foldr1
prop_foldr' :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr' `eq` foldr
prop_foldr1' :: P ((a -> a -> a) -> v a -> a) = notNull2 ===>
V.foldr1' `eq` foldr1
prop_ifoldl :: P ((a -> Int -> a -> a) -> a -> v a -> a)
= V.ifoldl `eq` ifoldl
prop_ifoldl' :: P ((a -> Int -> a -> a) -> a -> v a -> a)
= V.ifoldl' `eq` ifoldl
prop_ifoldr :: P ((Int -> a -> a -> a) -> a -> v a -> a)
= V.ifoldr `eq` ifoldr
prop_ifoldr' :: P ((Int -> a -> a -> a) -> a -> v a -> a)
= V.ifoldr' `eq` ifoldr
prop_ifoldM :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a)
= V.ifoldM `eq` ifoldM
prop_ifoldM' :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a)
= V.ifoldM' `eq` ifoldM
prop_ifoldM_ :: P ((() -> Int -> a -> Writer [a] ()) -> () -> v a -> Writer [a] ())
= V.ifoldM_ `eq` ifoldM_
prop_ifoldM'_ :: P ((() -> Int -> a -> Writer [a] ()) -> () -> v a -> Writer [a] ())
= V.ifoldM'_ `eq` ifoldM_
prop_all :: P ((a -> Bool) -> v a -> Bool) = V.all `eq` all
prop_any :: P ((a -> Bool) -> v a -> Bool) = V.any `eq` any
prop_prescanl :: P ((a -> a -> a) -> a -> v a -> v a)
= V.prescanl `eq` prescanl
prop_prescanl' :: P ((a -> a -> a) -> a -> v a -> v a)
= V.prescanl' `eq` prescanl
prop_postscanl :: P ((a -> a -> a) -> a -> v a -> v a)
= V.postscanl `eq` postscanl
prop_postscanl' :: P ((a -> a -> a) -> a -> v a -> v a)
= V.postscanl' `eq` postscanl
prop_scanl :: P ((a -> a -> a) -> a -> v a -> v a)
= V.scanl `eq` scanl
prop_scanl' :: P ((a -> a -> a) -> a -> v a -> v a)
= V.scanl' `eq` scanl
prop_scanl1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>
V.scanl1 `eq` scanl1
prop_scanl1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>
V.scanl1' `eq` scanl1
prop_iscanl :: P ((Int -> a -> a -> a) -> a -> v a -> v a)
= V.iscanl `eq` iscanl
prop_iscanl' :: P ((Int -> a -> a -> a) -> a -> v a -> v a)
= V.iscanl' `eq` iscanl
prop_prescanr :: P ((a -> a -> a) -> a -> v a -> v a)
= V.prescanr `eq` prescanr
prop_prescanr' :: P ((a -> a -> a) -> a -> v a -> v a)
= V.prescanr' `eq` prescanr
prop_postscanr :: P ((a -> a -> a) -> a -> v a -> v a)
= V.postscanr `eq` postscanr
prop_postscanr' :: P ((a -> a -> a) -> a -> v a -> v a)
= V.postscanr' `eq` postscanr
prop_scanr :: P ((a -> a -> a) -> a -> v a -> v a)
= V.scanr `eq` scanr
prop_scanr' :: P ((a -> a -> a) -> a -> v a -> v a)
= V.scanr' `eq` scanr
prop_iscanr :: P ((Int -> a -> a -> a) -> a -> v a -> v a)
= V.iscanr `eq` iscanr
prop_iscanr' :: P ((Int -> a -> a -> a) -> a -> v a -> v a)
= V.iscanr' `eq` iscanr
prop_scanr1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>
V.scanr1 `eq` scanr1
prop_scanr1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>
V.scanr1' `eq` scanr1
prop_concatMap = forAll arbitrary $ \xs ->
forAll (sized (\n -> resize (n `div` V.length xs) arbitrary)) $ \f -> unP prop f xs
where
prop :: P ((a -> v a) -> v a -> v a) = V.concatMap `eq` concatMap
prop_uniq :: P (v a -> v a)
= V.uniq `eq` (map head . group)
--prop_span = (V.span :: (a -> Bool) -> v a -> (v a, v a)) `eq2` span
--prop_break = (V.break :: (a -> Bool) -> v a -> (v a, v a)) `eq2` break
--prop_splitAt = (V.splitAt :: Int -> v a -> (v a, v a)) `eq2` splitAt
--prop_all = (V.all :: (a -> Bool) -> v a -> Bool) `eq2` all
--prop_any = (V.any :: (a -> Bool) -> v a -> Bool) `eq2` any
-- Data.List
--prop_findIndices = V.findIndices `eq2` (findIndices :: (a -> Bool) -> v a -> v Int)
--prop_isPrefixOf = V.isPrefixOf `eq2` (isPrefixOf :: v a -> v a -> Bool)
--prop_elemIndex = V.elemIndex `eq2` (elemIndex :: a -> v a -> Maybe Int)
--prop_elemIndices = V.elemIndices `eq2` (elemIndices :: a -> v a -> v Int)
--
--prop_mapAccumL = eq3
-- (V.mapAccumL :: (X -> W -> (X,W)) -> X -> B -> (X, B))
-- ( mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))
--
--prop_mapAccumR = eq3
-- (V.mapAccumR :: (X -> W -> (X,W)) -> X -> B -> (X, B))
-- ( mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))
-- Because the vectors are strict, we need to be totally sure that the unfold eventually terminates. This
-- is achieved by injecting our own bit of state into the unfold - the maximum number of unfolds allowed.
limitUnfolds f (theirs, ours)
| ours > 0
, Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))
| otherwise = Nothing
limitUnfoldsM f (theirs, ours)
| ours > 0 = do r <- f theirs
return $ (\(a,b) -> (a,(b,ours - 1))) `fmap` r
| otherwise = return Nothing
prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a)
= (\n f a -> V.unfoldr (limitUnfolds f) (a, n))
`eq` (\n f a -> unfoldr (limitUnfolds f) (a, n))
prop_unfoldrN :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a)
= V.unfoldrN `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n))
prop_unfoldrM :: P (Int -> (Int -> Writer [Int] (Maybe (a,Int))) -> Int -> Writer [Int] (v a))
= (\n f a -> V.unfoldrM (limitUnfoldsM f) (a,n))
`eq` (\n f a -> Util.unfoldrM (limitUnfoldsM f) (a, n))
prop_unfoldrNM :: P (Int -> (Int -> Writer [Int] (Maybe (a,Int))) -> Int -> Writer [Int] (v a))
= V.unfoldrNM `eq` (\n f a -> Util.unfoldrM (limitUnfoldsM f) (a, n))
prop_constructN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f
where
prop :: P (Int -> (v a -> a) -> v a) = V.constructN `eq` constructN []
constructN xs 0 _ = xs
constructN xs n f = constructN (xs ++ [f xs]) (n-1) f
prop_constructrN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f
where
prop :: P (Int -> (v a -> a) -> v a) = V.constructrN `eq` constructrN []
constructrN xs 0 _ = xs
constructrN xs n f = constructrN (f xs : xs) (n-1) f
testTuplyFunctions:: forall a v. (CommonContext a v, VectorContext (a, a) v, VectorContext (a, a, a) v) => v a -> [Test]
testTuplyFunctions _ = $(testProperties [ 'prop_zip, 'prop_zip3
, 'prop_unzip, 'prop_unzip3
, 'prop_mzip, 'prop_munzip
])
where
prop_zip :: P (v a -> v a -> v (a, a)) = V.zip `eq` zip
prop_zip3 :: P (v a -> v a -> v a -> v (a, a, a)) = V.zip3 `eq` zip3
prop_unzip :: P (v (a, a) -> (v a, v a)) = V.unzip `eq` unzip
prop_unzip3 :: P (v (a, a, a) -> (v a, v a, v a)) = V.unzip3 `eq` unzip3
prop_mzip :: P (Data.Vector.Vector a -> Data.Vector.Vector a -> Data.Vector.Vector (a, a))
= mzip `eq` zip
prop_munzip :: P (Data.Vector.Vector (a, a) -> (Data.Vector.Vector a, Data.Vector.Vector a))
= munzip `eq` unzip
testOrdFunctions :: forall a v. (CommonContext a v, Ord a, Ord (v a)) => v a -> [Test]
testOrdFunctions _ = $(testProperties
['prop_compare,
'prop_maximum, 'prop_minimum,
'prop_minIndex, 'prop_maxIndex ])
where
prop_compare :: P (v a -> v a -> Ordering) = compare `eq` compare
prop_maximum :: P (v a -> a) = not . V.null ===> V.maximum `eq` maximum
prop_minimum :: P (v a -> a) = not . V.null ===> V.minimum `eq` minimum
prop_minIndex :: P (v a -> Int) = not . V.null ===> V.minIndex `eq` minIndex
prop_maxIndex :: P (v a -> Int) = not . V.null ===> V.maxIndex `eq` maxIndex
testEnumFunctions :: forall a v. (CommonContext a v, Enum a, Ord a, Num a, Random a) => v a -> [Test]
testEnumFunctions _ = $(testProperties
[ 'prop_enumFromN, 'prop_enumFromThenN,
'prop_enumFromTo, 'prop_enumFromThenTo])
where
prop_enumFromN :: P (a -> Int -> v a)
= (\_ n -> n < 1000)
===> V.enumFromN `eq` (\x n -> take n $ scanl (+) x $ repeat 1)
prop_enumFromThenN :: P (a -> a -> Int -> v a)
= (\_ _ n -> n < 1000)
===> V.enumFromStepN `eq` (\x y n -> take n $ scanl (+) x $ repeat y)
prop_enumFromTo = \m ->
forAll (choose (-2,100)) $ \n ->
unP prop m (m+n)
where
prop :: P (a -> a -> v a) = V.enumFromTo `eq` enumFromTo
prop_enumFromThenTo = \i j ->
j /= i ==>
forAll (choose (ks i j)) $ \k ->
unP prop i j k
where
prop :: P (a -> a -> a -> v a) = V.enumFromThenTo `eq` enumFromThenTo
ks i j | j < i = (i-d*100, i+d*2)
| otherwise = (i-d*2, i+d*100)
where
d = abs (j-i)
testMonoidFunctions :: forall a v. (CommonContext a v, Monoid (v a)) => v a -> [Test]
testMonoidFunctions _ = $(testProperties
[ 'prop_mempty, 'prop_mappend, 'prop_mconcat ])
where
prop_mempty :: P (v a) = mempty `eq` mempty
prop_mappend :: P (v a -> v a -> v a) = mappend `eq` mappend
prop_mconcat :: P ([v a] -> v a) = mconcat `eq` mconcat
testFunctorFunctions :: forall a v. (CommonContext a v, Functor v) => v a -> [Test]
testFunctorFunctions _ = $(testProperties
[ 'prop_fmap ])
where
prop_fmap :: P ((a -> a) -> v a -> v a) = fmap `eq` fmap
testMonadFunctions :: forall a v. (CommonContext a v, Monad v) => v a -> [Test]
testMonadFunctions _ = $(testProperties
[ 'prop_return, 'prop_bind ])
where
prop_return :: P (a -> v a) = return `eq` return
prop_bind :: P (v a -> (a -> v a) -> v a) = (>>=) `eq` (>>=)
testApplicativeFunctions :: forall a v. (CommonContext a v, V.Vector v (a -> a), Applicative.Applicative v) => v a -> [Test]
testApplicativeFunctions _ = $(testProperties
[ 'prop_applicative_pure, 'prop_applicative_appl ])
where
prop_applicative_pure :: P (a -> v a)
= Applicative.pure `eq` Applicative.pure
prop_applicative_appl :: [a -> a] -> P (v a -> v a)
= \fs -> (Applicative.<*>) (V.fromList fs) `eq` (Applicative.<*>) fs
testAlternativeFunctions :: forall a v. (CommonContext a v, Applicative.Alternative v) => v a -> [Test]
testAlternativeFunctions _ = $(testProperties
[ 'prop_alternative_empty, 'prop_alternative_or ])
where
prop_alternative_empty :: P (v a) = Applicative.empty `eq` Applicative.empty
prop_alternative_or :: P (v a -> v a -> v a)
= (Applicative.<|>) `eq` (Applicative.<|>)
testBoolFunctions :: forall v. (CommonContext Bool v) => v Bool -> [Test]
testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or])
where
prop_and :: P (v Bool -> Bool) = V.and `eq` and
prop_or :: P (v Bool -> Bool) = V.or `eq` or
testNumFunctions :: forall a v. (CommonContext a v, Num a) => v a -> [Test]
testNumFunctions _ = $(testProperties ['prop_sum, 'prop_product])
where
prop_sum :: P (v a -> a) = V.sum `eq` sum
prop_product :: P (v a -> a) = V.product `eq` product
testNestedVectorFunctions :: forall a v. (CommonContext a v) => v a -> [Test]
testNestedVectorFunctions _ = $(testProperties [])
where
-- Prelude
--prop_concat = (V.concat :: [v a] -> v a) `eq1` concat
-- Data.List
--prop_transpose = V.transpose `eq1` (transpose :: [v a] -> [v a])
--prop_group = V.group `eq1` (group :: v a -> [v a])
--prop_inits = V.inits `eq1` (inits :: v a -> [v a])
--prop_tails = V.tails `eq1` (tails :: v a -> [v a])
testGeneralBoxedVector :: forall a. (CommonContext a Data.Vector.Vector, Ord a) => Data.Vector.Vector a -> [Test]
testGeneralBoxedVector dummy = concatMap ($ dummy) [
testSanity,
testPolymorphicFunctions,
testOrdFunctions,
testTuplyFunctions,
testNestedVectorFunctions,
testMonoidFunctions,
testFunctorFunctions,
testMonadFunctions,
testApplicativeFunctions,
testAlternativeFunctions
]
testBoolBoxedVector dummy = concatMap ($ dummy)
[
testGeneralBoxedVector
, testBoolFunctions
]
testNumericBoxedVector :: forall a. (CommonContext a Data.Vector.Vector, Ord a, Num a, Enum a, Random a) => Data.Vector.Vector a -> [Test]
testNumericBoxedVector dummy = concatMap ($ dummy)
[
testGeneralBoxedVector
, testNumFunctions
, testEnumFunctions
]
testGeneralPrimitiveVector :: forall a. (CommonContext a Data.Vector.Primitive.Vector, Data.Vector.Primitive.Prim a, Ord a) => Data.Vector.Primitive.Vector a -> [Test]
testGeneralPrimitiveVector dummy = concatMap ($ dummy) [
testSanity,
testPolymorphicFunctions,
testOrdFunctions,
testMonoidFunctions
]
testNumericPrimitiveVector :: forall a. (CommonContext a Data.Vector.Primitive.Vector, Data.Vector.Primitive.Prim a, Ord a, Num a, Enum a, Random a) => Data.Vector.Primitive.Vector a -> [Test]
testNumericPrimitiveVector dummy = concatMap ($ dummy)
[
testGeneralPrimitiveVector
, testNumFunctions
, testEnumFunctions
]
testGeneralStorableVector :: forall a. (CommonContext a Data.Vector.Storable.Vector, Data.Vector.Storable.Storable a, Ord a) => Data.Vector.Storable.Vector a -> [Test]
testGeneralStorableVector dummy = concatMap ($ dummy) [
testSanity,
testPolymorphicFunctions,
testOrdFunctions,
testMonoidFunctions
]
testNumericStorableVector :: forall a. (CommonContext a Data.Vector.Storable.Vector, Data.Vector.Storable.Storable a, Ord a, Num a, Enum a, Random a) => Data.Vector.Storable.Vector a -> [Test]
testNumericStorableVector dummy = concatMap ($ dummy)
[
testGeneralStorableVector
, testNumFunctions
, testEnumFunctions
]
testGeneralUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a) => Data.Vector.Unboxed.Vector a -> [Test]
testGeneralUnboxedVector dummy = concatMap ($ dummy) [
testSanity,
testPolymorphicFunctions,
testOrdFunctions,
testMonoidFunctions
]
testUnitUnboxedVector dummy = concatMap ($ dummy)
[
testGeneralUnboxedVector
]
testBoolUnboxedVector dummy = concatMap ($ dummy)
[
testGeneralUnboxedVector
, testBoolFunctions
]
testNumericUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a, Num a, Enum a, Random a) => Data.Vector.Unboxed.Vector a -> [Test]
testNumericUnboxedVector dummy = concatMap ($ dummy)
[
testGeneralUnboxedVector
, testNumFunctions
, testEnumFunctions
]
testTupleUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a) => Data.Vector.Unboxed.Vector a -> [Test]
testTupleUnboxedVector dummy = concatMap ($ dummy)
[
testGeneralUnboxedVector
]
tests = [
testGroup "Data.Vector.Vector (Bool)" (testBoolBoxedVector (undefined :: Data.Vector.Vector Bool)),
testGroup "Data.Vector.Vector (Int)" (testNumericBoxedVector (undefined :: Data.Vector.Vector Int)),
testGroup "Data.Vector.Primitive.Vector (Int)" (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Int)),
testGroup "Data.Vector.Primitive.Vector (Double)" (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Double)),
testGroup "Data.Vector.Storable.Vector (Int)" (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Int)),
testGroup "Data.Vector.Storable.Vector (Double)" (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Double)),
testGroup "Data.Vector.Unboxed.Vector ()" (testUnitUnboxedVector (undefined :: Data.Vector.Unboxed.Vector ())),
testGroup "Data.Vector.Unboxed.Vector (Bool)" (testBoolUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Bool)),
testGroup "Data.Vector.Unboxed.Vector (Int)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Int)),
testGroup "Data.Vector.Unboxed.Vector (Double)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Double)),
testGroup "Data.Vector.Unboxed.Vector (Int,Bool)" (testTupleUnboxedVector (undefined :: Data.Vector.Unboxed.Vector (Int,Bool))),
testGroup "Data.Vector.Unboxed.Vector (Int,Bool,Int)" (testTupleUnboxedVector (undefined :: Data.Vector.Unboxed.Vector (Int,Bool,Int)))
]