git.iko.soy/project-m36
on ac258da help sign in
project-m36/test/Relation/Basic.hs
84 lines 4.1 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.HashSet as HS
10import qualified Data.Vector as V
11import qualified Data.Set as S
12import System.Exit
13import ProjectM36.RelationalExpression
15testList :: Test
16testList = TestList [testRelation "relationTrue" relationTrue, testRelation "relationFalse" relationFalse,
17 testMkRelation1,
18 testRename1, testRename2,
19 testRelation "suppliers" suppliersRel,
20 testRelation "products" productsRel,
21 testRelation "supplierProducts" supplierProductsRel]
23main :: IO ()
24main = do
25 tcounts <- runTestTT testList
26 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
28testRelation :: String -> Relation -> Test
29testRelation testName rel = TestCase $ assertEqual testName relationValidation (Right rel)
30 where
31 relationValidation = validateRelation rel
33-- run common relation checks
34validateRelation :: Relation -> Either RelationalError Relation
35validateRelation rel = do
36 _ <- validateAttrNamesMatchTupleAttrNames rel
37 validateAttrTypesMatchTupleAttrTypes rel
39validateAttrNamesMatchTupleAttrNames :: Relation -> Either RelationalError Relation
40validateAttrNamesMatchTupleAttrNames rel@(Relation _ tupMapSet)
41 | HS.null invalidSet = Right rel
42 | otherwise = Left $ AttributeNamesMismatchError S.empty
43 where
44 nameCheck tuple = attributeNames rel == tupleAttributeNameSet tuple
45 invalidSet = HS.filter (not . nameCheck) tupMapSet
47validateAttrTypesMatchTupleAttrTypes :: Relation -> Either RelationalError Relation
48validateAttrTypesMatchTupleAttrTypes rel@(Relation attrs tupSet) = HS.foldr (\tuple acc ->
49 if (tupleAttributes tuple) == attrs && tupleAtomCheck tuple then
50 acc
51 else
52 Left $ TupleAttributeTypeMismatchError A.emptyAttributes
53 ) (Right rel) tupSet
54 where
55 tupleAtomCheck tuple = V.all (== True) (attrChecks tuple)
56 attrChecks tuple = V.map (\attr -> case atomForAttributeName (A.attributeName attr) tuple of
57 Left _ -> False
58 Right atom -> (Right $ atomTypeForAtom atom) ==
59 A.atomTypeForAttributeName (A.attributeName attr) attrs) (attributes rel)
61simpleRel :: Relation
62simpleRel = case mkRelation attrs tupleSet of
63 Right rel -> rel
64 Left _ -> undefined
65 where
66 attrs = A.attributesFromList [Attribute "a" StringAtomType, Attribute "b" StringAtomType]
67 tupleSet = HS.singleton $ mkRelationTuple attrs (V.fromList [StringAtom "spam", StringAtom "spam2"])
69--rename tests
70testRename1 :: Test
71testRename1 = TestCase $ assertEqual "attribute invalid" (rename "a" "b" relationTrue) (Left $ AttributeNamesMismatchError (S.singleton "a"))
73testRename2 :: Test
74testRename2 = TestCase $ assertEqual "attribute in use" (rename "b" "a" simpleRel) (Left $ AttributeNameInUseError "a")
76--mkRelation tests
77--test tupleset key mismatch failure
78testMkRelation1 :: Test
79testMkRelation1 = 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
80 where
81 testAttrs = A.attributesFromList [Attribute "a" StringAtomType]
82 testTupSet = HS.fromList [mkRelationTuple testAttrs $ V.fromList [StringAtom "v"],
83 mkRelationTuple testAttrs $ V.fromList [IntAtom 2]]