git.iko.soy/project-m36
on 3a76afa help sign in
project-m36/test/Relation/Basic.hs
83 lines 4.0 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2import Test.HUnit
3import ProjectM36.Base
4import ProjectM36.Relation
5import ProjectM36.Error
6import ProjectM36.Tuple
7import ProjectM36.Atom
8import qualified ProjectM36.Attribute as A
9import qualified Data.Vector as V
10import qualified Data.Set as S
11import System.Exit
12import ProjectM36.RelationalExpression
14testList :: Test
15testList = TestList [testRelation "relationTrue" relationTrue, testRelation "relationFalse" relationFalse,
16 testMkRelation1,
17 testRename1, testRename2,
18 testRelation "suppliers" suppliersRel,
19 testRelation "products" productsRel,
20 testRelation "supplierProducts" supplierProductsRel]
22main :: IO ()
23main = do
24 tcounts <- runTestTT testList
25 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
27testRelation :: String -> Relation -> Test
28testRelation testName rel = TestCase $ assertEqual testName relationValidation (Right rel)
29 where
30 relationValidation = validateRelation rel
32-- run common relation checks
33validateRelation :: Relation -> Either RelationalError Relation
34validateRelation rel = do
35 _ <- validateAttrNamesMatchTupleAttrNames rel
36 validateAttrTypesMatchTupleAttrTypes rel
38validateAttrNamesMatchTupleAttrNames :: Relation -> Either RelationalError Relation
39validateAttrNamesMatchTupleAttrNames rel@(Relation _ tupSet)
40 | null invalidSet = Right rel
41 | otherwise = Left $ AttributeNamesMismatchError S.empty
42 where
43 nameCheck tuple = attributeNames rel == tupleAttributeNameSet tuple
44 invalidSet = filter (not . nameCheck) (asList tupSet)
46validateAttrTypesMatchTupleAttrTypes :: Relation -> Either RelationalError Relation
47validateAttrTypesMatchTupleAttrTypes rel@(Relation attrs tupSet) = foldr (\tuple acc ->
48 if (tupleAttributes tuple) == attrs && tupleAtomCheck tuple then
49 acc
50 else
51 Left $ TupleAttributeTypeMismatchError A.emptyAttributes
52 ) (Right rel) (asList tupSet)
53 where
54 tupleAtomCheck tuple = V.all (== True) (attrChecks tuple)
55 attrChecks tuple = V.map (\attr -> case atomForAttributeName (A.attributeName attr) tuple of
56 Left _ -> False
57 Right atom -> (Right $ atomTypeForAtom atom) ==
58 A.atomTypeForAttributeName (A.attributeName attr) attrs) (attributes rel)
60simpleRel :: Relation
61simpleRel = case mkRelation attrs tupleSet of
62 Right rel -> rel
63 Left _ -> undefined
64 where
65 attrs = A.attributesFromList [Attribute "a" stringAtomType, Attribute "b" stringAtomType]
66 tupleSet = RelationTupleSet [mkRelationTuple attrs (V.fromList [stringAtom "spam", stringAtom "spam2"])]
68--rename tests
69testRename1 :: Test
70testRename1 = TestCase $ assertEqual "attribute invalid" (rename "a" "b" relationTrue) (Left $ AttributeNamesMismatchError (S.singleton "a"))
72testRename2 :: Test
73testRename2 = TestCase $ assertEqual "attribute in use" (rename "b" "a" simpleRel) (Left $ AttributeNameInUseError "a")
75--mkRelation tests
76--test tupleset key mismatch failure
77testMkRelation1 :: Test
78testMkRelation1 = TestCase $ assertEqual "key mismatch" (Left $ TupleAttributeTypeMismatchError A.emptyAttributes) (mkRelation testAttrs testTupSet) -- the error attribute set is empty due to an optimization- the tuple attrs do not match the atoms' types
79 where
80 testAttrs = A.attributesFromList [Attribute "a" stringAtomType]
81 testTupSet = RelationTupleSet [mkRelationTuple testAttrs $ V.fromList [stringAtom "v"],
82 mkRelationTuple testAttrs $ V.fromList [intAtom 2]]