From 2764c34b8d681ab6838a4a29de9c1c7252a698ee Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 11 Dec 2015 14:38:57 -0500 Subject: [PATCH] Generate arbitrary terms using frequency & sized bounds. --- test/Spec.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/test/Spec.hs b/test/Spec.hs index cc463c3da..d9262998b 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -32,7 +32,12 @@ instance (Eq a, Eq f, Arbitrary a, Arbitrary f) => Arbitrary (Syntax a f) where shrinkSyntax (Keyed k) = Keyed . Map.fromList <$> (List.subsequences (Map.toList k) >>= shrink) instance (Eq a, Eq annotation, Arbitrary a, Arbitrary annotation) => Arbitrary (ArbitraryTerm a annotation) where - arbitrary = arbitraryBounded 4 + arbitrary = sized boundedTerm + where boundedTerm n = ArbitraryTerm <$> ((,) <$> arbitrary <*> boundedSyntax n) + boundedSyntax 0 = liftM Leaf arbitrary + boundedSyntax n = frequency + [ (1, liftM Leaf arbitrary), + (4, liftM Indexed $ listOf $ boundedTerm $ n - 1) ] shrink term@(ArbitraryTerm (annotation, syntax)) = (++) (subterms term) $ filter (/= term) $ ArbitraryTerm <$> ((,) <$> shrink annotation <*> shrinkSyntax syntax) where shrinkSyntax (Leaf a) = Leaf <$> shrink a shrinkSyntax (Indexed i) = Indexed <$> (List.subsequences i >>= recursivelyShrink)