git.iko.soy/project-m36
on disk_format_proposal help sign in
project-m36/test/IsomorphicSchema.hs
128 lines 7.1 kB history raw
1import Test.HUnit
2import ProjectM36.Base
3import ProjectM36.Error
4import ProjectM36.IsomorphicSchema
5import ProjectM36.Relation
6import ProjectM36.RelationalExpression
7import qualified ProjectM36.DatabaseContext as DBC
8import qualified ProjectM36.Attribute as A
9import System.Exit
10import qualified Data.Map as M
11import qualified Data.Set as S
12import Control.Monad.State
13import Control.Monad.Trans.Reader
15testList :: Test
16testList = TestList [testIsoRename, testIsoRestrict, testIsoUnion, testSchemaValidation]
18main :: IO ()
19main = do
20 tcounts <- runTestTT testList
21 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
23assertEither :: (Show a) => Either a b -> IO b
24assertEither x = case x of
25 Left err -> assertFailure (show err) >> undefined
26 Right val -> pure val
28{-
29assertMaybe :: Maybe a -> String -> IO a
30assertMaybe x msg = case x of
31 Nothing -> assertFailure msg >> undefined
32 Just x' -> pure x'
33-}
35-- create some potential schemas which should not be accepted
36testSchemaValidation :: Test
37testSchemaValidation = TestCase $ do
38 let potentialSchema = DBC.basicDatabaseContext {
39 relationVariables = M.singleton "anotherRel" relationTrue
40 }
41 -- missing relvars failure
42 morphs = [IsoRename "true" "true", IsoRename "false" "false"]
43 missingRelVarError = Just (RelVarReferencesMissing (S.singleton "anotherRel"))
44 assertEqual "missing relvar validation" missingRelVarError (validateSchema (Schema morphs) potentialSchema)
45 -- duplicate relvar mention
46 let morphs' = [IsoRename "true" "true", IsoRename "false" "true", IsoRename "true" "anotherRel"]
47 duplicateRelVarError = Just (RelVarOutReferencedMoreThanOnce "true")
48 assertEqual "duplicate relvars in morphs" duplicateRelVarError (validateSchema (Schema morphs') potentialSchema)
50testIsoRename :: Test
51testIsoRename = TestCase $ do
52 -- create a schema with two relvars and rename one while the other remains the same in the isomorphic schema
53 let schemaA = mkRelationalExprState DBC.empty {
54 relationVariables = M.fromList [("employee", relationTrue),
55 ("department", relationFalse)]
56 }
57 isomorphsAtoB = [IsoRename "emp" "employee",
58 IsoRename "department" "department"]
59 unionExpr = Union (RelationVariable "emp" ()) (RelationVariable "department" ())
60 relExpr <- assertEither (applyRelationalExprSchemaIsomorphs isomorphsAtoB unionExpr)
61 let relResult = runReader (evalRelationalExpr relExpr) schemaA
62 assertEqual "employee relation morph" (Right relationTrue) relResult
64testIsoRestrict :: Test
65testIsoRestrict = TestCase $ do
66 -- create a emp relation which is restricted into two boss, nonboss rel vars
67 -- the virtual schema has an employee
68 let empattrs = A.attributesFromList [Attribute "name" TextAtomType,
69 Attribute "boss" TextAtomType]
70 emprel <- assertEither $ mkRelationFromList empattrs
71 [[TextAtom "Steve", TextAtom ""],
72 [TextAtom "Cindy", TextAtom "Steve"],
73 [TextAtom "Sam", TextAtom "Steve"]]
74 let predicate = AttributeEqualityPredicate "boss" (NakedAtomExpr (TextAtom ""))
75 bossRel <- assertEither $ runReader (evalRelationalExpr (Restrict predicate (ExistingRelation emprel))) (mkRelationalExprState DBC.empty)
76 nonBossRel <- assertEither $ runReader (evalRelationalExpr (Restrict (NotPredicate predicate) (ExistingRelation emprel))) (mkRelationalExprState DBC.empty)
78 let schemaA = mkRelationalExprState DBC.empty {
79 relationVariables = M.fromList [("nonboss", nonBossRel),
80 ("boss", bossRel)]
81 }
83 isomorphsAtoB = [IsoRestrict "employee" predicate ("boss", "nonboss")]
84 bossq = RelationVariable "boss" ()
85 nonbossq = RelationVariable "nonboss" ()
86 employeeq = RelationVariable "employee" ()
87 unionq = Union bossq nonbossq
88 empExpr <- assertEither (applyRelationalExprSchemaIsomorphs isomorphsAtoB employeeq)
89 let empResult = runReader (evalRelationalExpr empExpr) schemaA
90 unionResult = runReader (evalRelationalExpr unionq) schemaA
91 assertEqual "boss/nonboss isorestrict" unionResult empResult
92 --execute database context expr
93 bobRel <- assertEither (mkRelationFromList empattrs [[TextAtom "Bob", TextAtom ""]])
94 let schemaBInsertExpr = Insert "employee" (ExistingRelation bobRel)
95 schemaBInsertExpr' <- assertEither (processDatabaseContextExprInSchema (Schema isomorphsAtoB) schemaBInsertExpr)
96 let (postInsertContext,_,_) = execState (evalDatabaseContextExpr schemaBInsertExpr') (freshDatabaseState (stateElemsContext schemaA))
97 expectedRel = runReader (evalRelationalExpr (Union (RelationVariable "boss" ()) (RelationVariable "nonboss" ()))) (mkRelationalExprState postInsertContext)
98 --execute the expression against the schema and compare against the base context
99 processedExpr <- assertEither (processRelationalExprInSchema (Schema isomorphsAtoB) (RelationVariable "employee" ()))
100 let processedRel = runReader (evalRelationalExpr processedExpr) (mkRelationalExprState postInsertContext)
101 assertEqual "insert bob boss" expectedRel processedRel
103testIsoUnion :: Test
104testIsoUnion = TestCase $ do
105 --create motors relation which is split into low-power (<50 horsepower) and high-power (>=50 horsepower) motors
106 --the schema is contains the split relvars
107 motorsRel <- assertEither $ mkRelationFromList (A.attributesFromList [Attribute "name" TextAtomType,
108 Attribute "power" IntAtomType])
109 [[TextAtom "Puny", IntAtom 10],
110 [TextAtom "Scooter", IntAtom 49],
111 [TextAtom "Auto", IntAtom 200],
112 [TextAtom "Tractor", IntAtom 500]]
113 let baseSchema = mkRelationalExprState DBC.basicDatabaseContext {
114 relationVariables = M.singleton "motor" motorsRel
115 }
116 splitPredicate = AtomExprPredicate (FunctionAtomExpr "lt" [AttributeAtomExpr "power", NakedAtomExpr (IntAtom 50)] ())
117 splitIsomorphs = [IsoUnion ("lowpower", "highpower") splitPredicate "motor",
118 IsoRename "true" "true",
119 IsoRename "false" "false"]
120 lowmotors = runReader (evalRelationalExpr (Restrict splitPredicate (RelationVariable "motor" ()))) baseSchema
121 highmotors = runReader (evalRelationalExpr (Restrict (NotPredicate splitPredicate) (RelationVariable "motor" ()))) baseSchema
122 relResult expr = runReader (evalRelationalExpr expr) baseSchema
123 lowpowerExpr <- assertEither (processRelationalExprInSchema (Schema splitIsomorphs) (RelationVariable "lowpower" ()))
124 lowpowerRel <- assertEither (relResult lowpowerExpr)
125 highpowerExpr <- assertEither (processRelationalExprInSchema (Schema splitIsomorphs) (RelationVariable "highpower" ()))
126 highpowerRel <- assertEither (relResult highpowerExpr)
127 assertEqual "lowpower relation difference" (Right lowpowerRel) lowmotors
128 assertEqual "highpower relation difference" (Right highpowerRel) highmotors