feat(third_party/bazel): Check in rules_haskell from Tweag

third_party/bazel/rules_haskell/examples/vector/tests/Boilerplater.hs

@@ -0,0 +1,27 @@
+module Boilerplater where
+
+import Test.Framework.Providers.QuickCheck2
+
+import Language.Haskell.TH
+
+
+testProperties :: [Name] -> Q Exp
+testProperties nms = fmap ListE $ sequence [[| testProperty $(stringE prop_name) $(varE nm) |]
+                                           | nm <- nms
+                                           , Just prop_name <- [stripPrefix_maybe "prop_" (nameBase nm)]]
+
+-- This nice clean solution doesn't quite work since I need to use lexically-scoped type
+-- variables, which aren't supported by Template Haskell. Argh!
+-- testProperties :: Q [Dec] -> Q Exp
+-- testProperties mdecs = do
+--     decs <- mdecs
+--     property_exprs <- sequence [[| testProperty "$prop_name" $(return $ VarE nm) |]
+--                                | FunD nm _clauses <- decs
+--                                , Just prop_name <- [stripPrefix_maybe "prop_" (nameBase nm)]]
+--     return $ LetE decs (ListE property_exprs)
+
+stripPrefix_maybe :: String -> String -> Maybe String
+stripPrefix_maybe prefix what
+  | what_start == prefix = Just what_end
+  | otherwise            = Nothing
+  where (what_start, what_end) = splitAt (length prefix) what

third_party/bazel/rules_haskell/examples/vector/tests/LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2009, Max Bolingbroke and Roman Leshchinskiy
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+ 
+- Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+ 
+- Neither name of the University nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission. 
+
+THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.
+

third_party/bazel/rules_haskell/examples/vector/tests/Main.hs

@@ -0,0 +1,15 @@
+module Main (main) where
+
+import qualified Tests.Vector
+import qualified Tests.Vector.UnitTests
+import qualified Tests.Bundle
+import qualified Tests.Move
+
+import Test.Framework (defaultMain)
+
+main :: IO ()
+main = defaultMain $ Tests.Bundle.tests
+                  ++ Tests.Vector.tests
+                  ++ Tests.Vector.UnitTests.tests
+                  ++ Tests.Move.tests
+

third_party/bazel/rules_haskell/examples/vector/tests/Setup.hs

@@ -0,0 +1,3 @@
+import Distribution.Simple
+main = defaultMain
+

third_party/bazel/rules_haskell/examples/vector/tests/Tests/Bundle.hs

@@ -0,0 +1,163 @@
+module Tests.Bundle ( tests ) where
+
+import Boilerplater
+import Utilities
+
+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           (foldl', foldl1', unfoldr, find, findIndex)
+import System.Random       (Random)
+
+#define COMMON_CONTEXT(a) \
+ VANILLA_CONTEXT(a)
+
+#define VANILLA_CONTEXT(a) \
+  Eq a,     Show a,     Arbitrary a,     CoArbitrary a,     TestData a,     Model a ~ a,        EqTest a ~ Property
+
+testSanity :: forall v a. (COMMON_CONTEXT(a)) => S.Bundle v a -> [Test]
+testSanity _ = [
+        testProperty "fromList.toList == id" prop_fromList_toList,
+        testProperty "toList.fromList == id" prop_toList_fromList
+    ]
+  where
+    prop_fromList_toList :: P (S.Bundle v a -> S.Bundle v a)
+        = (S.fromList . S.toList) `eq` id
+    prop_toList_fromList :: P ([a] -> [a])
+        = (S.toList . (S.fromList :: [a] -> S.Bundle v a)) `eq` id
+
+testPolymorphicFunctions :: forall v a. (COMMON_CONTEXT(a)) => S.Bundle v a -> [Test]
+testPolymorphicFunctions _ = $(testProperties [
+        'prop_eq,
+
+        'prop_length, 'prop_null,
+
+        'prop_empty, 'prop_singleton, 'prop_replicate,
+        'prop_cons, 'prop_snoc, 'prop_append,
+
+        'prop_head, 'prop_last, 'prop_index,
+
+        'prop_extract, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop,
+
+        'prop_map, 'prop_zipWith, 'prop_zipWith3,
+        'prop_filter, 'prop_takeWhile, 'prop_dropWhile,
+
+        'prop_elem, 'prop_notElem,
+        'prop_find, 'prop_findIndex,
+
+        'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1',
+        'prop_foldr, 'prop_foldr1,
+
+        'prop_prescanl, 'prop_prescanl',
+        'prop_postscanl, 'prop_postscanl',
+        'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1',
+
+        'prop_concatMap,
+        'prop_unfoldr
+    ])
+  where
+    -- Prelude
+    prop_eq :: P (S.Bundle v a -> S.Bundle v a -> Bool) = (==) `eq` (==)
+
+    prop_length :: P (S.Bundle v a -> Int)     = S.length `eq` length
+    prop_null   :: P (S.Bundle v a -> Bool)    = S.null `eq` null
+    prop_empty  :: P (S.Bundle v a)            = S.empty `eq` []
+    prop_singleton :: P (a -> S.Bundle v a)    = S.singleton `eq` singleton
+    prop_replicate :: P (Int -> a -> S.Bundle v a)
+              = (\n _ -> n < 1000) ===> S.replicate `eq` replicate
+    prop_cons      :: P (a -> S.Bundle v a -> S.Bundle v a) = S.cons `eq` (:)
+    prop_snoc      :: P (S.Bundle v a -> a -> S.Bundle v a) = S.snoc `eq` snoc
+    prop_append    :: P (S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = (S.++) `eq` (++)
+
+    prop_head      :: P (S.Bundle v a -> a) = not . S.null ===> S.head `eq` head
+    prop_last      :: P (S.Bundle v a -> a) = not . S.null ===> S.last `eq` last
+    prop_index        = \xs ->
+                        not (S.null xs) ==>
+                        forAll (choose (0, S.length xs-1)) $ \i ->
+                        unP prop xs i
+      where
+        prop :: P (S.Bundle v a -> Int -> a) = (S.!!) `eq` (!!)
+
+    prop_extract      = \xs ->
+                        forAll (choose (0, S.length xs))     $ \i ->
+                        forAll (choose (0, S.length xs - i)) $ \n ->
+                        unP prop i n xs
+      where
+        prop :: P (Int -> Int -> S.Bundle v a -> S.Bundle v a) = S.slice `eq` slice
+
+    prop_tail :: P (S.Bundle v a -> S.Bundle v a) = not . S.null ===> S.tail `eq` tail
+    prop_init :: P (S.Bundle v a -> S.Bundle v a) = not . S.null ===> S.init `eq` init
+    prop_take :: P (Int -> S.Bundle v a -> S.Bundle v a) = S.take `eq` take
+    prop_drop :: P (Int -> S.Bundle v a -> S.Bundle v a) = S.drop `eq` drop
+
+    prop_map :: P ((a -> a) -> S.Bundle v a -> S.Bundle v a) = S.map `eq` map
+    prop_zipWith :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = S.zipWith `eq` zipWith
+    prop_zipWith3 :: P ((a -> a -> a -> a) -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a)
+             = S.zipWith3 `eq` zipWith3
+
+    prop_filter :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.filter `eq` filter
+    prop_takeWhile :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.takeWhile `eq` takeWhile
+    prop_dropWhile :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.dropWhile `eq` dropWhile
+
+    prop_elem    :: P (a -> S.Bundle v a -> Bool) = S.elem `eq` elem
+    prop_notElem :: P (a -> S.Bundle v a -> Bool) = S.notElem `eq` notElem
+    prop_find    :: P ((a -> Bool) -> S.Bundle v a -> Maybe a) = S.find `eq` find
+    prop_findIndex :: P ((a -> Bool) -> S.Bundle v a -> Maybe Int)
+      = S.findIndex `eq` findIndex
+
+    prop_foldl :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldl `eq` foldl
+    prop_foldl1 :: P ((a -> a -> a) -> S.Bundle v a -> a)     = notNullS2 ===>
+                        S.foldl1 `eq` foldl1
+    prop_foldl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldl' `eq` foldl'
+    prop_foldl1' :: P ((a -> a -> a) -> S.Bundle v a -> a)     = notNullS2 ===>
+                        S.foldl1' `eq` foldl1'
+    prop_foldr :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldr `eq` foldr
+    prop_foldr1 :: P ((a -> a -> a) -> S.Bundle v a -> a)     = notNullS2 ===>
+                        S.foldr1 `eq` foldr1
+
+    prop_prescanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)
+                = S.prescanl `eq` prescanl
+    prop_prescanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)
+                = S.prescanl' `eq` prescanl
+    prop_postscanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)
+                = S.postscanl `eq` postscanl
+    prop_postscanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)
+                = S.postscanl' `eq` postscanl
+    prop_scanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)
+                = S.scanl `eq` scanl
+    prop_scanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)
+               = S.scanl' `eq` scanl
+    prop_scanl1 :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a) = notNullS2 ===>
+                 S.scanl1 `eq` scanl1
+    prop_scanl1' :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a) = notNullS2 ===>
+                 S.scanl1' `eq` scanl1
+ 
+    prop_concatMap    = forAll arbitrary $ \xs ->
+                        forAll (sized (\n -> resize (n `div` S.length xs) arbitrary)) $ \f -> unP prop f xs
+      where
+        prop :: P ((a -> S.Bundle v a) -> S.Bundle v a -> S.Bundle v a) = S.concatMap `eq` concatMap
+
+    limitUnfolds f (theirs, ours) | ours >= 0
+                                  , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))
+                                  | otherwise                       = Nothing
+    prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> S.Bundle v a)
+         = (\n f a -> S.unfoldr (limitUnfolds f) (a, n))
+           `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n))
+
+testBoolFunctions :: forall v. S.Bundle v Bool -> [Test]
+testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or ])
+  where
+    prop_and :: P (S.Bundle v Bool -> Bool) = S.and `eq` and
+    prop_or  :: P (S.Bundle v Bool -> Bool) = S.or `eq` or
+
+testBundleFunctions = testSanity (undefined :: S.Bundle v Int)
+                      ++ testPolymorphicFunctions (undefined :: S.Bundle v Int)
+                      ++ testBoolFunctions (undefined :: S.Bundle v Bool)
+
+tests = [ testGroup "Data.Vector.Fusion.Bundle" testBundleFunctions ]
+

third_party/bazel/rules_haskell/examples/vector/tests/Tests/Move.hs

@@ -0,0 +1,49 @@
+module Tests.Move (tests) where
+
+import Test.QuickCheck
+import Test.Framework.Providers.QuickCheck2
+import Test.QuickCheck.Property (Property(..))
+
+import Utilities ()
+
+import Control.Monad (replicateM)
+import Control.Monad.ST (runST)
+import Data.List (sort,permutations)
+
+import qualified Data.Vector.Generic as G
+import qualified Data.Vector.Generic.Mutable as M
+
+import qualified Data.Vector as V
+import qualified Data.Vector.Primitive as P
+import qualified Data.Vector.Storable as S
+import qualified Data.Vector.Unboxed as U
+
+basicMove :: G.Vector v a => v a -> Int -> Int -> Int -> v a
+basicMove v dstOff srcOff len
+  | len > 0 = G.modify (\ mv -> G.copy (M.slice dstOff len mv) (G.slice srcOff len v)) v
+  | otherwise = v
+
+testMove :: (G.Vector v a, Show (v a), Eq (v a)) => v a -> Property
+testMove v = G.length v > 0 ==> (MkProperty $ do
+  dstOff <- choose (0, G.length v - 1)
+  srcOff <- choose (0, G.length v - 1)
+  len <- choose (1, G.length v - max dstOff srcOff)
+  expected <- return $ basicMove v dstOff srcOff len
+  actual <- return $  G.modify (\ mv -> M.move (M.slice dstOff len mv) (M.slice srcOff len mv)) v
+  unProperty $ counterexample ("Move: " ++ show (v, dstOff, srcOff, len)) (expected == actual))
+
+checkPermutations :: Int -> Bool
+checkPermutations n = runST $ do
+    vec <- U.thaw (U.fromList [1..n])
+    res <- replicateM (product [1..n]) $ M.nextPermutation vec >> U.freeze vec >>= return . U.toList
+    return $! ([1..n] : res) == sort (permutations [1..n]) ++ [[n,n-1..1]]
+
+testPermutations :: Bool
+testPermutations = all checkPermutations [1..7]
+
+tests =
+    [testProperty "Data.Vector.Mutable (Move)" (testMove :: V.Vector Int -> Property),
+     testProperty "Data.Vector.Primitive.Mutable (Move)" (testMove :: P.Vector Int -> Property),
+     testProperty "Data.Vector.Unboxed.Mutable (Move)" (testMove :: U.Vector Int -> Property),
+     testProperty "Data.Vector.Storable.Mutable (Move)" (testMove :: S.Vector Int -> Property),
+     testProperty "Data.Vector.Generic.Mutable (nextPermutation)" testPermutations]

third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector.hs

@@ -0,0 +1,706 @@
+{-# 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)))
+
+    ]

third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector/UnitTests.hs

@@ -0,0 +1,48 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Tests.Vector.UnitTests (tests) where
+
+import Control.Applicative as Applicative
+import qualified Data.Vector.Storable as Storable
+import Foreign.Ptr
+import Foreign.Storable
+import Text.Printf
+
+import Test.Framework
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit (Assertion, assertBool)
+
+newtype Aligned a = Aligned { getAligned :: a }
+
+instance (Storable a) => Storable (Aligned a) where
+  sizeOf _    = sizeOf (undefined :: a)
+  alignment _ = 128
+  peek ptr    = Aligned Applicative.<$> peek (castPtr ptr)
+  poke ptr    = poke (castPtr ptr) . getAligned
+
+checkAddressAlignment :: forall a. (Storable a) => Storable.Vector a -> Assertion
+checkAddressAlignment xs = Storable.unsafeWith xs $ \ptr -> do
+  let ptr'  = ptrToWordPtr ptr
+      msg   = printf "Expected pointer with alignment %d but got 0x%08x" (toInteger align) (toInteger ptr')
+      align :: WordPtr
+      align = fromIntegral $ alignment dummy
+  assertBool msg $ (ptr' `mod` align) == 0
+  where
+    dummy :: a
+    dummy = undefined
+
+tests :: [Test]
+tests =
+  [ testGroup "Data.Vector.Storable.Vector Alignment"
+      [ testCase "Aligned Double" $
+          checkAddressAlignment alignedDoubleVec
+      , testCase "Aligned Int" $
+          checkAddressAlignment alignedIntVec
+      ]
+  ]
+
+alignedDoubleVec :: Storable.Vector (Aligned Double)
+alignedDoubleVec = Storable.fromList $ map Aligned [1, 2, 3, 4, 5]
+
+alignedIntVec :: Storable.Vector (Aligned Int)
+alignedIntVec = Storable.fromList $ map Aligned [1, 2, 3, 4, 5]

third_party/bazel/rules_haskell/examples/vector/tests/Utilities.hs

@@ -0,0 +1,350 @@
+{-# LANGUAGE FlexibleInstances, GADTs #-}
+module Utilities where
+
+import Test.QuickCheck
+
+import qualified Data.Vector as DV
+import qualified Data.Vector.Generic as DVG
+import qualified Data.Vector.Primitive as DVP
+import qualified Data.Vector.Storable as DVS
+import qualified Data.Vector.Unboxed as DVU
+import qualified Data.Vector.Fusion.Bundle as S
+
+import Control.Monad (foldM, foldM_, zipWithM, zipWithM_)
+import Control.Monad.Trans.Writer
+import Data.Function (on)
+import Data.Functor.Identity
+import Data.List ( sortBy )
+import Data.Monoid
+import Data.Maybe (catMaybes)
+
+instance Show a => Show (S.Bundle v a) where
+    show s = "Data.Vector.Fusion.Bundle.fromList " ++ show (S.toList s)
+
+
+instance Arbitrary a => Arbitrary (DV.Vector a) where
+    arbitrary = fmap DV.fromList arbitrary
+
+instance CoArbitrary a => CoArbitrary (DV.Vector a) where
+    coarbitrary = coarbitrary . DV.toList
+
+instance (Arbitrary a, DVP.Prim a) => Arbitrary (DVP.Vector a) where
+    arbitrary = fmap DVP.fromList arbitrary
+
+instance (CoArbitrary a, DVP.Prim a) => CoArbitrary (DVP.Vector a) where
+    coarbitrary = coarbitrary . DVP.toList
+
+instance (Arbitrary a, DVS.Storable a) => Arbitrary (DVS.Vector a) where
+    arbitrary = fmap DVS.fromList arbitrary
+
+instance (CoArbitrary a, DVS.Storable a) => CoArbitrary (DVS.Vector a) where
+    coarbitrary = coarbitrary . DVS.toList
+
+instance (Arbitrary a, DVU.Unbox a) => Arbitrary (DVU.Vector a) where
+    arbitrary = fmap DVU.fromList arbitrary
+
+instance (CoArbitrary a, DVU.Unbox a) => CoArbitrary (DVU.Vector a) where
+    coarbitrary = coarbitrary . DVU.toList
+
+instance Arbitrary a => Arbitrary (S.Bundle v a) where
+    arbitrary = fmap S.fromList arbitrary
+
+instance CoArbitrary a => CoArbitrary (S.Bundle v a) where
+    coarbitrary = coarbitrary . S.toList
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Writer a b) where
+    arbitrary = do b <- arbitrary
+                   a <- arbitrary
+                   return $ writer (b,a)
+
+instance CoArbitrary a => CoArbitrary (Writer a ()) where
+    coarbitrary = coarbitrary . runWriter
+
+class (Testable (EqTest a), Conclusion (EqTest a)) => TestData a where
+  type Model a
+  model :: a -> Model a
+  unmodel :: Model a -> a
+
+  type EqTest a
+  equal :: a -> a -> EqTest a
+
+instance Eq a => TestData (S.Bundle v a) where
+  type Model (S.Bundle v a) = [a]
+  model = S.toList
+  unmodel = S.fromList
+
+  type EqTest (S.Bundle v a) = Property
+  equal x y = property (x == y)
+
+instance Eq a => TestData (DV.Vector a) where
+  type Model (DV.Vector a) = [a]
+  model = DV.toList
+  unmodel = DV.fromList
+
+  type EqTest (DV.Vector a) = Property
+  equal x y = property (x == y)
+
+instance (Eq a, DVP.Prim a) => TestData (DVP.Vector a) where
+  type Model (DVP.Vector a) = [a]
+  model = DVP.toList
+  unmodel = DVP.fromList
+
+  type EqTest (DVP.Vector a) = Property
+  equal x y = property (x == y)
+
+instance (Eq a, DVS.Storable a) => TestData (DVS.Vector a) where
+  type Model (DVS.Vector a) = [a]
+  model = DVS.toList
+  unmodel = DVS.fromList
+
+  type EqTest (DVS.Vector a) = Property
+  equal x y = property (x == y)
+
+instance (Eq a, DVU.Unbox a) => TestData (DVU.Vector a) where
+  type Model (DVU.Vector a) = [a]
+  model = DVU.toList
+  unmodel = DVU.fromList
+
+  type EqTest (DVU.Vector a) = Property
+  equal x y = property (x == y)
+
+#define id_TestData(ty) \
+instance TestData ty where { \
+  type Model ty = ty;        \
+  model = id;                \
+  unmodel = id;              \
+                             \
+  type EqTest ty = Property; \
+  equal x y = property (x == y) }
+
+id_TestData(())
+id_TestData(Bool)
+id_TestData(Int)
+id_TestData(Float)
+id_TestData(Double)
+id_TestData(Ordering)
+
+-- Functorish models
+-- All of these need UndecidableInstances although they are actually well founded. Oh well.
+instance (Eq a, TestData a) => TestData (Maybe a) where
+  type Model (Maybe a) = Maybe (Model a)
+  model = fmap model
+  unmodel = fmap unmodel
+
+  type EqTest (Maybe a) = Property
+  equal x y = property (x == y)
+
+instance (Eq a, TestData a) => TestData [a] where
+  type Model [a] = [Model a]
+  model = fmap model
+  unmodel = fmap unmodel
+
+  type EqTest [a] = Property
+  equal x y = property (x == y)
+
+instance (Eq a, TestData a) => TestData (Identity a) where
+  type Model (Identity a) = Identity (Model a)
+  model = fmap model
+  unmodel = fmap unmodel
+
+  type EqTest (Identity a) = Property
+  equal = (property .) . on (==) runIdentity
+
+instance (Eq a, TestData a, Eq b, TestData b, Monoid a) => TestData (Writer a b) where
+  type Model (Writer a b) = Writer (Model a) (Model b)
+  model = mapWriter model
+  unmodel = mapWriter unmodel
+
+  type EqTest (Writer a b) = Property
+  equal = (property .) . on (==) runWriter
+
+instance (Eq a, Eq b, TestData a, TestData b) => TestData (a,b) where
+  type Model (a,b) = (Model a, Model b)
+  model (a,b) = (model a, model b)
+  unmodel (a,b) = (unmodel a, unmodel b)
+
+  type EqTest (a,b) = Property
+  equal x y = property (x == y)
+
+instance (Eq a, Eq b, Eq c, TestData a, TestData b, TestData c) => TestData (a,b,c) where
+  type Model (a,b,c) = (Model a, Model b, Model c)
+  model (a,b,c) = (model a, model b, model c)
+  unmodel (a,b,c) = (unmodel a, unmodel b, unmodel c)
+
+  type EqTest (a,b,c) = Property
+  equal x y = property (x == y)
+
+instance (Arbitrary a, Show a, TestData a, TestData b) => TestData (a -> b) where
+  type Model (a -> b) = Model a -> Model b
+  model f = model . f . unmodel
+  unmodel f = unmodel . f . model
+
+  type EqTest (a -> b) = a -> EqTest b
+  equal f g x = equal (f x) (g x)
+
+newtype P a = P { unP :: EqTest a }
+
+instance TestData a => Testable (P a) where
+  property (P a) = property a
+
+infix 4 `eq`
+eq :: TestData a => a -> Model a -> P a
+eq x y = P (equal x (unmodel y))
+
+class Conclusion p where
+  type Predicate p
+
+  predicate :: Predicate p -> p -> p
+
+instance Conclusion Property where
+  type Predicate Property = Bool
+
+  predicate = (==>)
+
+instance Conclusion p => Conclusion (a -> p) where
+  type Predicate (a -> p) = a -> Predicate p
+
+  predicate f p = \x -> predicate (f x) (p x)
+
+infixr 0 ===>
+(===>) :: TestData a => Predicate (EqTest a) -> P a -> P a
+p ===> P a = P (predicate p a)
+
+notNull2 _ xs = not $ DVG.null xs
+notNullS2 _ s = not $ S.null s
+
+-- Generators
+index_value_pairs :: Arbitrary a => Int -> Gen [(Int,a)]
+index_value_pairs 0 = return []
+index_value_pairs m = sized $ \n ->
+  do
+    len <- choose (0,n)
+    is <- sequence [choose (0,m-1) | i <- [1..len]]
+    xs <- vector len
+    return $ zip is xs
+
+indices :: Int -> Gen [Int]
+indices 0 = return []
+indices m = sized $ \n ->
+  do
+    len <- choose (0,n)
+    sequence [choose (0,m-1) | i <- [1..len]]
+
+
+-- Additional list functions
+singleton x = [x]
+snoc xs x = xs ++ [x]
+generate n f = [f i | i <- [0 .. n-1]]
+slice i n xs = take n (drop i xs)
+backpermute xs is = map (xs!!) is
+prescanl f z = init . scanl f z
+postscanl f z = tail . scanl f z
+prescanr f z = tail . scanr f z
+postscanr f z = init . scanr f z
+
+accum :: (a -> b -> a) -> [a] -> [(Int,b)] -> [a]
+accum f xs ps = go xs ps' 0
+  where
+    ps' = sortBy (\p q -> compare (fst p) (fst q)) ps
+
+    go (x:xs) ((i,y) : ps) j
+      | i == j     = go (f x y : xs) ps j
+    go (x:xs) ps j = x : go xs ps (j+1)
+    go [] _ _      = []
+
+(//) :: [a] -> [(Int, a)] -> [a]
+xs // ps = go xs ps' 0
+  where
+    ps' = sortBy (\p q -> compare (fst p) (fst q)) ps
+
+    go (x:xs) ((i,y) : ps) j
+      | i == j     = go (y:xs) ps j
+    go (x:xs) ps j = x : go xs ps (j+1)
+    go [] _ _      = []
+
+
+withIndexFirst m f = m (uncurry f) . zip [0..]
+
+imap :: (Int -> a -> a) -> [a] -> [a]
+imap = withIndexFirst map
+
+imapM :: Monad m => (Int -> a -> m a) -> [a] -> m [a]
+imapM = withIndexFirst mapM
+
+imapM_ :: Monad m => (Int -> a -> m b) -> [a] -> m ()
+imapM_ = withIndexFirst mapM_
+
+izipWith :: (Int -> a -> a -> a) -> [a] -> [a] -> [a]
+izipWith = withIndexFirst zipWith
+
+izipWithM :: Monad m => (Int -> a -> a -> m a) -> [a] -> [a] -> m [a]
+izipWithM = withIndexFirst zipWithM
+
+izipWithM_ :: Monad m => (Int -> a -> a -> m b) -> [a] -> [a] -> m ()
+izipWithM_ = withIndexFirst zipWithM_
+
+izipWith3 :: (Int -> a -> a -> a -> a) -> [a] -> [a] -> [a] -> [a]
+izipWith3 = withIndexFirst zipWith3
+
+ifilter :: (Int -> a -> Bool) -> [a] -> [a]
+ifilter f = map snd . withIndexFirst filter f
+
+mapMaybe :: (a -> Maybe b) -> [a] -> [b]
+mapMaybe f = catMaybes . map f
+
+imapMaybe :: (Int -> a -> Maybe b) -> [a] -> [b]
+imapMaybe f = catMaybes . withIndexFirst map f
+
+indexedLeftFold fld f z = fld (uncurry . f) z . zip [0..]
+
+ifoldl :: (a -> Int -> a -> a) -> a -> [a] -> a
+ifoldl = indexedLeftFold foldl
+
+iscanl :: (Int -> a -> b -> a) -> a -> [b] -> [a]
+iscanl f z = scanl (\a (i, b) -> f i a b) z . zip [0..]
+
+iscanr :: (Int -> a -> b -> b) -> b -> [a] -> [b]
+iscanr f z = scanr (uncurry f) z . zip [0..]
+
+ifoldr :: (Int -> a -> b -> b) -> b -> [a] -> b
+ifoldr f z = foldr (uncurry f) z . zip [0..]
+
+ifoldM :: Monad m => (a -> Int -> a -> m a) -> a -> [a] -> m a
+ifoldM = indexedLeftFold foldM
+
+ifoldM_ :: Monad m => (b -> Int -> a -> m b) -> b -> [a] -> m ()
+ifoldM_ = indexedLeftFold foldM_
+
+minIndex :: Ord a => [a] -> Int
+minIndex = fst . foldr1 imin . zip [0..]
+  where
+    imin (i,x) (j,y) | x <= y    = (i,x)
+                     | otherwise = (j,y)
+
+maxIndex :: Ord a => [a] -> Int
+maxIndex = fst . foldr1 imax . zip [0..]
+  where
+    imax (i,x) (j,y) | x >= y    = (i,x)
+                     | otherwise = (j,y)
+
+iterateNM :: Monad m => Int -> (a -> m a) -> a -> m [a]
+iterateNM n f x
+    | n <= 0    = return []
+    | n == 1    = return [x]
+    | otherwise =  do x' <- f x
+                      xs <- iterateNM (n-1) f x'
+                      return (x : xs)
+
+unfoldrM :: Monad m => (b -> m (Maybe (a,b))) -> b -> m [a]
+unfoldrM step b0 = do
+    r <- step b0
+    case r of
+      Nothing    -> return []
+      Just (a,b) -> do as <- unfoldrM step b
+                       return (a : as)
+
+
+limitUnfolds f (theirs, ours)
+    | ours >= 0
+    , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))
+    | otherwise                       = Nothing