git.iko.soy/project-m36
on d64cdeb help sign in
project-m36/test/Relation/Basic.hs
106 lines 5.4 kB history raw
1import Test.HUnit
2import ProjectM36.Base
3import ProjectM36.Relation
4import ProjectM36.Error
5import ProjectM36.DateExamples
6import ProjectM36.TupleSet
7import ProjectM36.Attribute hiding (null, attributeNames)
8import ProjectM36.DataTypes.Primitive
9import ProjectM36.RelationalExpression
10import ProjectM36.Tuple
11import qualified ProjectM36.DatabaseContext as DBC
12import Control.Monad.Trans.Reader
13import qualified ProjectM36.Attribute as A
14import qualified Data.Map as M
15import qualified Data.Vector as V
16import qualified Data.Set as S
17import System.Exit
20testList :: Test
21testList = TestList [testRelation "relationTrue" relationTrue, testRelation "relationFalse" relationFalse,
22 testMkRelation1,
23 testRename1, testRename2,
24 testRelation "suppliers" suppliersRel,
25 testRelation "products" productsRel,
26 testRelation "supplierProducts" supplierProductsRel,
27 testMkRelationFromExprsBadAttrs,
28 testDuplicateAttributes
29 ]
31main :: IO ()
32main = do
33 tcounts <- runTestTT testList
34 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
36testRelation :: String -> Relation -> Test
37testRelation testName rel = TestCase $ assertEqual testName relationValidation (Right rel)
38 where
39 relationValidation = validateRelation rel
41-- run common relation checks
42validateRelation :: Relation -> Either RelationalError Relation
43validateRelation rel = do
44 _ <- validateAttrNamesMatchTupleAttrNames rel
45 validateAttrTypesMatchTupleAttrTypes rel
47validateAttrNamesMatchTupleAttrNames :: Relation -> Either RelationalError Relation
48validateAttrNamesMatchTupleAttrNames rel@(Relation _ tupSet)
49 | null invalidSet = Right rel
50 | otherwise = Left $ AttributeNamesMismatchError S.empty
51 where
52 nameCheck tuple = attributeNames rel == tupleAttributeNameSet tuple
53 invalidSet = filter (not . nameCheck) (asList tupSet)
55validateAttrTypesMatchTupleAttrTypes :: Relation -> Either RelationalError Relation
56validateAttrTypesMatchTupleAttrTypes rel@(Relation attrs tupSet) = foldr (\tuple acc ->
57 if tupleAttributes tuple == attrs && tupleAtomCheck tuple then
58 acc
59 else
60 Left $ TupleAttributeTypeMismatchError A.emptyAttributes
61 ) (Right rel) (asList tupSet)
62 where
63 tupleAtomCheck tuple = V.all (== True) (attrChecks tuple)
64 attrChecks tuple = V.map (\attr -> case atomForAttributeName (A.attributeName attr) tuple of
65 Left _ -> False
66 Right atom -> (Right $ atomTypeForAtom atom) ==
67 A.atomTypeForAttributeName (A.attributeName attr) attrs) (attributes rel)
69simpleRel :: Relation
70simpleRel = case mkRelation attrs tupleSet of
71 Right rel -> rel
72 Left _ -> undefined
73 where
74 attrs = A.attributesFromList [Attribute "a" TextAtomType, Attribute "b" TextAtomType]
75 tupleSet = RelationTupleSet [mkRelationTuple attrs (V.fromList [TextAtom "spam", TextAtom "spam2"])]
77--rename tests
78testRename1 :: Test
79testRename1 = TestCase $ assertEqual "attribute invalid" (rename "a" "b" relationTrue) (Left $ AttributeNamesMismatchError (S.singleton "a"))
81testRename2 :: Test
82testRename2 = TestCase $ assertEqual "attribute in use" (rename "b" "a" simpleRel) (Left $ AttributeNameInUseError "a")
84--mkRelation tests
85--test tupleset key mismatch failure
86testMkRelation1 :: Test
87testMkRelation1 = TestCase $ assertEqual "key mismatch" expectedError (mkRelation testAttrs testTupSet) -- the error attribute set is empty due to an optimization- the tuple attrs do not match the atoms' types
88 where
89 expectedError = Left (AtomTypeMismatchError TextAtomType IntAtomType)
90 testAttrs = A.attributesFromList [Attribute "a" TextAtomType]
91 testTupSet = RelationTupleSet [mkRelationTuple testAttrs $ V.fromList [TextAtom "v"],
92 mkRelationTuple testAttrs $ V.fromList [IntAtom 2]]
94testMkRelationFromExprsBadAttrs :: Test
95testMkRelationFromExprsBadAttrs = TestCase $ do
96 let context = DBC.empty
97 case runReader (evalRelationalExpr (MakeRelationFromExprs (Just [AttributeAndTypeNameExpr "badAttr1" (PrimitiveTypeConstructor "Int" IntAtomType) ()]) [TupleExpr (M.singleton "badAttr2" (NakedAtomExpr (IntAtom 1)))])) (mkRelationalExprState context) of
98 Left err -> assertEqual "tuple type mismatch" (TupleAttributeTypeMismatchError (A.attributesFromList [Attribute "badAttr2" IntAtomType])) err
99 Right _ -> assertFailure "expected tuple type mismatch"
101--creating an empty relation with duplicate attribute names should fail
102testDuplicateAttributes :: Test
103testDuplicateAttributes = TestCase $ do
104 let eRel = mkRelation attrs emptyTupleSet
105 attrs = attributesFromList [Attribute "a" IntAtomType, Attribute "a" TextAtomType]
106 assertEqual "duplicate attribute names" (Left (DuplicateAttributeNamesError (S.singleton "a"))) eRel