mirror of
https://github.com/github/semantic.git
synced 2024-12-26 00:12:29 +03:00
Define shrink by case analysis.
This commit is contained in:
parent
2e97bf44fc
commit
76f78234aa
11
test/Spec.hs
11
test/Spec.hs
@ -39,11 +39,12 @@ instance (Eq a, Eq annotation, Arbitrary a, Arbitrary annotation) => Arbitrary (
|
|||||||
[ (1, liftM Leaf arbitrary),
|
[ (1, liftM Leaf arbitrary),
|
||||||
(4, liftM Indexed . listOf . boundedTerm $ n - 1),
|
(4, liftM Indexed . listOf . boundedTerm $ n - 1),
|
||||||
(4, liftM Fixed . listOf . boundedTerm $ n - 1) ]
|
(4, liftM Fixed . listOf . boundedTerm $ n - 1) ]
|
||||||
shrink term@(ArbitraryTerm (annotation, syntax)) = (++) (subterms term) $ filter (/= term) $ ArbitraryTerm <$> ((,) <$> shrink annotation <*> shrinkSyntax syntax)
|
shrink term@(ArbitraryTerm (annotation, syntax)) = (++) (subterms term) $ filter (/= term) $
|
||||||
where shrinkSyntax (Leaf a) = Leaf <$> shrink a
|
ArbitraryTerm <$> ((,) <$> shrink annotation <*> case syntax of
|
||||||
shrinkSyntax (Indexed i) = Indexed <$> (List.subsequences i >>= recursivelyShrink)
|
Leaf a -> Leaf <$> shrink a
|
||||||
shrinkSyntax (Fixed f) = Fixed <$> (List.subsequences f >>= recursivelyShrink)
|
Indexed i -> Indexed <$> (List.subsequences i >>= recursivelyShrink)
|
||||||
shrinkSyntax (Keyed k) = Keyed . Map.fromList <$> (List.subsequences (Map.toList k) >>= recursivelyShrink)
|
Fixed f -> Fixed <$> (List.subsequences f >>= recursivelyShrink)
|
||||||
|
Keyed k -> Keyed . Map.fromList <$> (List.subsequences (Map.toList k) >>= recursivelyShrink))
|
||||||
|
|
||||||
arbitraryBounded :: (Arbitrary a, Arbitrary annotation) => Int -> Gen (ArbitraryTerm a annotation)
|
arbitraryBounded :: (Arbitrary a, Arbitrary annotation) => Int -> Gen (ArbitraryTerm a annotation)
|
||||||
arbitraryBounded k = ArbitraryTerm <$> ((,) <$> arbitrary <*> oneof [
|
arbitraryBounded k = ArbitraryTerm <$> ((,) <$> arbitrary <*> oneof [
|
||||||
|
Loading…
Reference in New Issue
Block a user