@@ -399,13 +399,10 @@ evalGraphRefDatabaseContextExpr (Define relVarName attrExprs) = do
399399 let eAttrs = runGraphRefRelationalExprM gfEnv (mapM evalGraphRefAttrExpr attrExprs)
400400 gfEnv = freshGraphRefRelationalExprEnv (Just context) graph
401401 case eAttrs of
402− Left err -> dbErr err
402+ Left err -> dbErr err
403403 Right attrsList -> do
404− let atomTypeErrs = lefts $ map ((`validateAtomType` tConss) . A.atomType) attrsList
405− if not (null atomTypeErrs) then
406− dbErr (someErrors atomTypeErrs)
407− else
408− case M.member relVarName relvars of
404+ lift $ except $ validateAttributes tConss (A.attributesFromList attrsList)
405+ case M.member relVarName relvars of
409406 True -> dbErr (RelVarAlreadyDefinedError relVarName)
410407 False -> setRelVar relVarName (ExistingRelation emptyRelation)
411408 where
@@ -418,15 +415,17 @@ evalGraphRefDatabaseContextExpr (Assign relVarName expr) = do
418415 graph <- re_graph <$> dbcRelationalExprEnv
419416 context <- getStateContext
420417 let existingRelVar = M.lookup relVarName (relationVariables context)
421− reEnv = freshGraphRefRelationalExprEnv (Just context) graph
418+ reEnv = freshGraphRefRelationalExprEnv (Just context) graph
419+ eNewExprType = runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr expr)
422420 case existingRelVar of
423421 Nothing -> do
424422 case runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr expr) of
425423 Left err -> dbErr err
426− Right _ -> setRelVar relVarName expr
424+ Right reltype -> do
425+ lift $ except $ validateAttributes (typeConstructorMapping context) (attributes reltype)
426+ setRelVar relVarName expr
427427 Just existingRel -> do
428428 let eExpectedType = runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr existingRel)
429− eNewExprType = runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr expr)
430429 case eExpectedType of
431430 Left err -> dbErr err
432431 Right expectedType ->
@@ -434,6 +433,7 @@ evalGraphRefDatabaseContextExpr (Assign relVarName expr) = do
434433 Left err -> dbErr err
435434 Right newExprType -> do
436435 if newExprType == expectedType then do
436+ lift $ except $ validateAttributes (typeConstructorMapping context) (attributes newExprType)
437437 setRelVar relVarName expr
438438 else
439439 dbErr (RelationTypeMismatchError (attributes expectedType) (attributes newExprType))
@@ -1128,7 +1128,36 @@ evalGraphRefAttrExpr (AttributeAndTypeNameExpr attrName tCons transId) = do
11281128 pure $ Attribute attrName aType
11291129
11301130evalGraphRefAttrExpr (NakedAttributeExpr attr) = pure attr
1131−
1131+
1132+-- for tuple type concrete resolution (Nothing ==> Maybe Int) when the attributes hint is Nothing, we need to first process all the tuples, then extract the concrete types on a per-attribute basis, then reprocess the tuples to include the concrete types
1133+evalGraphRefTupleExprs :: Maybe Attributes -> [GraphRefTupleExpr] -> GraphRefRelationalExprM [RelationTuple]
1134+evalGraphRefTupleExprs mAttrs tupleExprs = do
1135+ tuples <- mapM (evalGraphRefTupleExpr mAttrs) tupleExprs
1136+ finalAttrs <- case mAttrs of
1137+ Just attrs -> pure attrs
1138+ Nothing ->
1139+ case tuples of
1140+ [] -> pure emptyAttributes
1141+ (headTuple:tailTuples) -> do
1142+ --gather up resolved atom types or throw an error if an attribute cannot be made concrete from the inferred types- this could still fail if the type cannot be inferred (e.g. from [Nothing, Nothing])
1143+ let mostResolvedTypes =
1144+ foldr (\tup acc ->
1145+ fmap (\(tupAttr,accAttr) -> --if the attribute is a constructedatomtype, we can recurse into it to potentially resolve type variables
1146+ if isResolvedAttribute accAttr then
1147+ accAttr
1148+ else
1149+ case resolveAttributes accAttr tupAttr of
1150+ Left _ -> accAttr
1151+ Right val -> val) (zip (V.toList $ tupleAttributes tup) acc)) (V.toList $ tupleAttributes headTuple) tailTuples
1152+ pure (A.attributesFromList mostResolvedTypes)
1153+ --is it OK to get the tConsMap like this and use it uniformly across the tuples- couldn't the tuple expressions use types from other parts of the graph? Maybe it's OK because this is only used
1154+ tConsMap <- typeConstructorMapping <$> gfDatabaseContextForMarker UncommittedContextMarker
1155+ lift $ except $ validateAttributes tConsMap finalAttrs
1156+ mapM (\tup -> lift $ except $ resolveTypesInTuple finalAttrs tConsMap tup) tuples
1157+
1158+
1159+--resolveAttributes (Attribute "gonk" (ConstructedAtomType "Either" (fromList [("a",IntegerAtomType),("b",TypeVariableType "b")]))) (Attribute "gonk" (ConstructedAtomType "Either" (fromList [("a",TypeVariableType "a"),("b",TextAtomType)])))
1160+
11321161evalGraphRefTupleExpr :: Maybe Attributes -> GraphRefTupleExpr -> GraphRefRelationalExprM RelationTuple
11331162evalGraphRefTupleExpr mAttrs (TupleExpr tupMap) = do
11341163 -- it's not possible for AtomExprs in tuple constructors to reference other Attributes' atoms due to the necessary order-of-operations (need a tuple to pass to evalAtomExpr)- it may be possible with some refactoring of type usage or delayed evaluation- needs more thought, but not a priority
@@ -1153,7 +1182,7 @@ evalGraphRefTupleExpr mAttrs (TupleExpr tupMap) = do
11531182 --verify that the attributes match
11541183 when (A.attributeNameSet finalAttrs /= A.attributeNameSet tupAttrs) $ throwError (TupleAttributeTypeMismatchError tupAttrs)
11551184 --we can't resolve types here- they have to be resolved at the atom level where the graph ref is held
1156−-- tup' <- lift $ except (resolveTypesInTuple finalAttrs tConss (reorderTuple finalAttrs tup))
1185+ --tup' <- lift $ except (resolveTypesInTuple finalAttrs tConss (reorderTuple finalAttrs tup))
11571186 let tup' = reorderTuple finalAttrs tup
11581187 --TODO: restore type resolution
11591188-- _ <- lift $ except (validateTuple tup' tConss)
@@ -1216,7 +1245,7 @@ evalGraphRefRelationalExpr (MakeRelationFromExprs mAttrExprs tupleExprs) = do
12161245 Just _ ->
12171246 Just . A.attributesFromList <$> mapM evalGraphRefAttrExpr (fromMaybe [] mAttrExprs)
12181247 Nothing -> pure Nothing
1219− tuples <- mapM (evalGraphRefTupleExpr mAttrs) tupleExprs
1248+ tuples <- evalGraphRefTupleExprs mAttrs tupleExprs
12201249 let attrs = fromMaybe firstTupleAttrs mAttrs
12211250 firstTupleAttrs = if null tuples then A.emptyAttributes else tupleAttributes (head tuples)
12221251 lift $ except $ mkRelation attrs (RelationTupleSet tuples)
@@ -1301,7 +1330,7 @@ typeForGraphRefRelationalExpr (MakeRelationFromExprs mAttrExprs tupleExprs) = do
13011330 attrs <- mapM (\e -> evalGraphRefAttributeExpr e) attrExprs
13021331 pure (Just (attributesFromList attrs))
13031332 Nothing -> pure Nothing
1304− tuples <- mapM (evalGraphRefTupleExpr mAttrs) tupleExprs
1333+ tuples <- evalGraphRefTupleExprs mAttrs tupleExprs
13051334 let retAttrs = case tuples of
13061335 (tup:_) -> tupleAttributes tup
13071336 [] -> fromMaybe A.emptyAttributes mAttrs