From f723b8b878a3c4a4687b9e337a875500bebb39b1 Mon Sep 17 00:00:00 2001 From: Vincent Ambo Date: Thu, 4 Jul 2019 11:18:12 +0100 Subject: feat(third_party/bazel): Check in rules_haskell from Tweag --- .../examples/vector/tests/Tests/Bundle.hs | 163 +++++++++++++++++++++ 1 file changed, 163 insertions(+) create mode 100644 third_party/bazel/rules_haskell/examples/vector/tests/Tests/Bundle.hs (limited to 'third_party/bazel/rules_haskell/examples/vector/tests/Tests/Bundle.hs') diff --git a/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Bundle.hs b/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Bundle.hs new file mode 100644 index 000000000000..09368a199971 --- /dev/null +++ b/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 ] + -- cgit 1.4.1