@@ -56,22 +56,31 @@ instance Arbitrary Pattern where
5656 PData s ps -> ps ++ (PData <$> shrinkWHead s <*> shrink ps)
5757 where shrinkWHead (x:xs) = (x:) <$> shrink xs
5858
59+isValidType :: Type -> Bool
60+isValidType (Lambda s t) = isValidType s && isValidType t
61+isValidType (Record [] (Just _)) = False
62+isValidType (Record (("",_):_) _) = False
63+isValidType (Record fs _) = all isValidType $ map snd fs
64+isValidType (Data _ []) = False
65+isValidType (Data _ ts) = all isValidType ts
66+isValidType _ = True
67+
5968instance Arbitrary Type where
60− arbitrary = sized tipe
69+ arbitrary = sized tipe `suchThat` isValidType
6170 where tipe :: Int -> Gen Type
6271 tipe n = oneof [ Lambda <$> depthTipe <*> depthTipe
63− , Var <$> arbitrary
64− , Data <$> arbitrary <*> listOf1 depthTipe
65− , Record <$> listOf ((,) <$> arbitrary <*> depthTipe) <*> arbitrary
72+ , Var <$> lowVar
73+ , Data <$> capVar <*> listOf1 depthTipe
74+ , Record <$> listOf ((,) <$> lowVar <*> depthTipe) <*> maybeOf lowVar
6675 ]
6776 where depthTipe :: Gen Type
6877 depthTipe = choose (0,n) >>= tipe
6978
70− shrink tipe = case tipe of
79+ shrink tipe = filter isValidType $ case tipe of
7180 Lambda s t -> Lambda <$> shrink s <*> shrink t
7281 Var _ -> []
7382 Data n ts -> Data n <$> shrink ts
74− Record fs t -> Record <$> shrink fs <*> pure t
83+ Record fs t -> Record <$> shrink fs <*> pure t
7584
7685lowVar :: Gen String
7786lowVar = notReserved $ (:) <$> lower <*> listOf varLetter
@@ -84,6 +93,9 @@ capVar = notReserved $ (:) <$> upper <*> listOf varLetter
8493varLetter :: Gen Char
8594varLetter = elements $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ['\'', '_']
8695
96+maybeOf :: Gen a -> Gen (Maybe a)
97+maybeOf g = oneof [ pure Nothing, Just <$> g ]
98+
8799notReserved :: Gen String -> Gen String
88100notReserved = flip exceptFor Parse.Helpers.reserveds
89101