1
1
mirror of https://github.com/github/semantic.git synced 2024-11-24 08:54:07 +03:00

Abstract ArbitraryTerm over its annotation type.

This commit is contained in:
Rob Rix 2015-12-11 00:35:00 -05:00
parent de9aa14da4
commit 0c23f11d01

View File

@ -14,7 +14,7 @@ import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck
newtype ArbitraryTerm a = ArbitraryTerm (Term a ())
newtype ArbitraryTerm a annotation = ArbitraryTerm (Term a annotation)
deriving (Show, Eq)
newtype ArbitrarySyntax a f = ArbitrarySyntax (Syntax a f)
@ -27,8 +27,8 @@ instance (Arbitrary a, Arbitrary f) => Arbitrary (ArbitrarySyntax a f) where
ArbitrarySyntax . Syntax.Fixed <$> arbitrary,
ArbitrarySyntax . Keyed . Map.fromList <$> arbitrary ]
instance Arbitrary a => Arbitrary (ArbitraryTerm a) where
arbitrary = oneof [ ArbitraryTerm . (() :<) . Leaf <$> arbitrary ]
instance (Arbitrary a, Arbitrary annotation) => Arbitrary (ArbitraryTerm a annotation) where
arbitrary = oneof [ (\ annotation leaf -> ArbitraryTerm $ annotation :< Leaf leaf) <$> arbitrary <*> arbitrary ]
instance Arbitrary HTML where
arbitrary = oneof [
@ -49,7 +49,7 @@ main :: IO ()
main = hspec $ do
describe "Term" $ do
prop "equality is reflexive" $
\ a -> a == (a :: ArbitraryTerm String)
\ a -> a == (a :: ArbitraryTerm String ())
describe "annotatedToRows" $ do
it "outputs one row for single-line unchanged leaves" $