@@ -24,6 +24,11 @@ assertEither x = case x of
2424 Left err -> assertFailure (show err) >> undefined
2525 Right val -> pure val
2626
27+assertMaybe :: Maybe a -> String -> IO a
28+assertMaybe x msg = case x of
29+ Nothing -> assertFailure msg >> undefined
30+ Just x' -> pure x'
31+
2732-- create some potential schemas which should not be accepted
2833testSchemaValidation :: Test
2934testSchemaValidation = TestCase $ do
@@ -57,8 +62,9 @@ testIsoRestrict :: Test
5762testIsoRestrict = TestCase $ do
5863 -- create a emp relation which is restricted into two boss, nonboss rel vars
5964 -- the virtual schema has an employee
60− emprel <- assertEither $ mkRelationFromList (A.attributesFromList [Attribute "name" TextAtomType,
61− Attribute "boss" TextAtomType])
65+ let empattrs = (A.attributesFromList [Attribute "name" TextAtomType,
66+ Attribute "boss" TextAtomType])
67+ emprel <- assertEither $ mkRelationFromList empattrs
6268 [[TextAtom "Steve", TextAtom ""],
6369 [TextAtom "Cindy", TextAtom "Steve"],
6470 [TextAtom "Sam", TextAtom "Steve"]]
@@ -80,7 +86,16 @@ testIsoRestrict = TestCase $ do
8086 let empResult = evalState (evalRelationalExpr empExpr) schemaA
8187 unionResult = evalState (evalRelationalExpr unionq) schemaA
8288 assertEqual "boss/nonboss isorestrict" unionResult empResult
83− -- TODO: add databaseContextExprs
89+ --execute database context expr
90+ bobRel <- assertEither (mkRelationFromList empattrs [[TextAtom "Bob", TextAtom ""]])
91+ let schemaBInsertExpr = Insert "employee" (ExistingRelation bobRel)
92+ schemaBInsertExpr' <- assertEither (processDatabaseContextExprInSchema (Schema isomorphsAtoB) schemaBInsertExpr)
93+ let postInsertContext = execState (evalContextExpr schemaBInsertExpr') schemaA
94+ expectedRel = evalState (evalRelationalExpr (Union (RelationVariable "boss" ()) (RelationVariable "nonboss" ()))) postInsertContext
95+ --execute the expression against the schema and compare against the base context
96+ processedExpr <- assertEither (processRelationalExprInSchema (Schema isomorphsAtoB) (RelationVariable "employee" ()))
97+ let processedRel = evalState (evalRelationalExpr processedExpr) postInsertContext
98+ assertEqual "insert bob boss" expectedRel processedRel
8499
85100testIsoUnion :: Test
86101testIsoUnion = TestCase $ do