@@ -142,7 +142,7 @@ resolveAttributeExprTypeVars (AttributeAndTypeNameExpr _ tCons _) aType tConsMap
142validateTypeConstructorDef :: TypeConstructorDef -> [DataConstructorDef] -> TypeConstructorMapping -> Either RelationalError ()
142validateTypeConstructorDef :: TypeConstructorDef -> [DataConstructorDef] -> TypeConstructorMapping -> Either RelationalError ()
143validateTypeConstructorDef tConsDef dConsList tConsMap = do
143validateTypeConstructorDef tConsDef dConsList tConsMap = do
144 let duplicateDConsNames = dupes (L.sort (map DCD.name dConsList))
144 let duplicateDConsNames = dupes (L.sort (map DCD.name dConsList))
145− when (length duplicateDConsNames > 0) (Left (someErrors (map DataConstructorNameInUseError duplicateDConsNames)))
145+ unless (null duplicateDConsNames) (Left (someErrors (map DataConstructorNameInUseError duplicateDConsNames)))
146 let leftSideVars = S.fromList (TCD.typeVars tConsDef)
146 let leftSideVars = S.fromList (TCD.typeVars tConsDef)
147 rightSideVars = S.unions (map DCD.typeVars dConsList)
147 rightSideVars = S.unions (map DCD.typeVars dConsList)
148 varsDiff = S.difference leftSideVars rightSideVars
148 varsDiff = S.difference leftSideVars rightSideVars
@@ -151,10 +151,10 @@ validateTypeConstructorDef tConsDef dConsList tConsMap = do
152--check that the data constructor names are not in use (recursively)
152--check that the data constructor names are not in use (recursively)
153validateDataConstructorDef :: DataConstructorDef -> TypeConstructorDef -> TypeConstructorMapping -> Either RelationalError ()
153validateDataConstructorDef :: DataConstructorDef -> TypeConstructorDef -> TypeConstructorMapping -> Either RelationalError ()
154−validateDataConstructorDef (DataConstructorDef dConsName dConsDefArgs) tConsDef tConsMap = do
154+validateDataConstructorDef (DataConstructorDef dConsName dConsDefArgs) tConsDef tConsMap =
155 case findDataConstructor dConsName tConsMap of
155 case findDataConstructor dConsName tConsMap of
156 Just _ -> Left (DataConstructorNameInUseError dConsName)
156 Just _ -> Left (DataConstructorNameInUseError dConsName)
157− Nothing -> do
157+ Nothing ->
158 mapM_ (\arg -> validateDataConstructorDefArg arg tConsDef tConsMap) dConsDefArgs
158 mapM_ (\arg -> validateDataConstructorDefArg arg tConsDef tConsMap) dConsDefArgs
@@ -162,14 +162,12 @@ validateDataConstructorDefArg :: DataConstructorDefArg -> TypeConstructorDef ->
162validateDataConstructorDefArg (DataConstructorDefTypeConstructorArg (PrimitiveTypeConstructor _ _)) _ _ = Right ()
162validateDataConstructorDefArg (DataConstructorDefTypeConstructorArg (PrimitiveTypeConstructor _ _)) _ _ = Right ()
163validateDataConstructorDefArg (DataConstructorDefTypeConstructorArg (TypeVariable _)) _ _ = Right ()
163validateDataConstructorDefArg (DataConstructorDefTypeConstructorArg (TypeVariable _)) _ _ = Right ()
164validateDataConstructorDefArg (DataConstructorDefTypeConstructorArg tCons) tConsDef tConsMap = case findTypeConstructor (TC.name tCons) tConsMap of
164validateDataConstructorDefArg (DataConstructorDefTypeConstructorArg tCons) tConsDef tConsMap = case findTypeConstructor (TC.name tCons) tConsMap of
165− Nothing -> do
165+ Nothing ->
166 when (TC.name tCons /= TCD.name tConsDef) (Left (NoSuchTypeConstructorName (TC.name tCons))) --allows for recursively-defined types
166 when (TC.name tCons /= TCD.name tConsDef) (Left (NoSuchTypeConstructorName (TC.name tCons))) --allows for recursively-defined types
168 Just (ADTypeConstructorDef _ tConsArgs, _) -> do --validate that the argument count matches- type matching can occur later
167 Just (ADTypeConstructorDef _ tConsArgs, _) -> do --validate that the argument count matches- type matching can occur later
169 let existingCount = length tConsArgs
168 let existingCount = length tConsArgs
170 newCount = length (TC.arguments tCons)
169 newCount = length (TC.arguments tCons)
171 when (newCount /= existingCount) (Left (ConstructedAtomArgumentCountMismatchError existingCount newCount))
170 when (newCount /= existingCount) (Left (ConstructedAtomArgumentCountMismatchError existingCount newCount))
173 Just (PrimitiveTypeConstructorDef _ _, _) -> pure ()
171 Just (PrimitiveTypeConstructorDef _ _, _) -> pure ()
174validateDataConstructorDefArg (DataConstructorDefTypeVarNameArg _) _ _ = Right ()
172validateDataConstructorDefArg (DataConstructorDefTypeVarNameArg _) _ _ = Right ()