git.iko.soy/project-m36
on 69ff6cd help sign in
project-m36/src/lib/ProjectM36/Key.hs
69 lines 3.5 kB history raw
1module ProjectM36.Key where
2import ProjectM36.Base
3import ProjectM36.Relation
4import qualified Data.Set as S
5#if __GLASGOW_HASKELL__ < 804
6import Data.Monoid
7#endif
9{-
10keys can be implemented using inclusion dependencies as well: the count of the projection of the keys' attributes must be equal to the count of the tuples- p. 120 Database in Depth
12example:
13:showexpr ((relation{tuple{}}:{a:=S}):{b:=count(@a)}){b}
14┌─┐
15│b│
16├─┤
17│5│
18└─┘
19((relation{tuple{}}:{a:=S{S#}}):{b:=count(@a)}){b}
20┌─┐
21│b│
22├─┤
23│5│
24└─┘
25-}
27-- | Create a uniqueness constraint for the attribute names and relational expression. Note that constraint can span multiple relation variables.
28inclusionDependencyForKey :: AttributeNames -> RelationalExpr -> InclusionDependency
29inclusionDependencyForKey attrNames relExpr = --InclusionDependency name (exprCount relExpr) (exprCount (projectedOnKeys relExpr))
30 InclusionDependency equalityExpr (ExistingRelation relationFalse)
31 where
32 projectedOnKeys = Project attrNames
33 exprAsSubRelation expr = Extend (AttributeExtendTupleExpr "a" (RelationAtomExpr expr)) (ExistingRelation relationTrue)
34 exprCount expr = projectionForCount (Extend (AttributeExtendTupleExpr "b" (FunctionAtomExpr "count" [AttributeAtomExpr "a"] () )) (exprAsSubRelation expr))
35 projectionForCount = Project (AttributeNames $ S.fromList ["b"])
36 equalityExpr = NotEquals (exprCount relExpr) (exprCount (projectedOnKeys relExpr))
38-- | Create a 'DatabaseContextExpr' which can be used to add a uniqueness constraint to attributes on one relation variable.
39databaseContextExprForUniqueKey :: RelVarName -> [AttributeName] -> DatabaseContextExpr
40databaseContextExprForUniqueKey rvName attrNames = AddInclusionDependency (rvName <> "_key") $ inclusionDependencyForKey (AttributeNames (S.fromList attrNames)) (RelationVariable rvName ())
42-- | Create a foreign key constraint from the first relation variable and attributes to the second.
43databaseContextExprForForeignKey :: IncDepName -> (RelVarName, [AttributeName]) -> (RelVarName, [AttributeName]) -> DatabaseContextExpr
44databaseContextExprForForeignKey fkName infoA infoB =
45 AddInclusionDependency fkName (inclusionDependencyForForeignKey infoA infoB)
47inclusionDependencyForForeignKey :: (RelVarName, [AttributeName]) -> (RelVarName, [AttributeName]) -> InclusionDependency
48inclusionDependencyForForeignKey (rvA, attrsA) (rvB, attrsB) =
49 InclusionDependency (
50 renameIfNecessary attrsB attrsA (Project (attrsL attrsA)
51 (RelationVariable rvA ()))) (
52 Project (attrsL attrsB) (RelationVariable rvB ()))
53 where
54 attrsL = AttributeNames . S.fromList
55 renameIfNecessary attrsExpected attrsExisting expr = foldr folder expr (zip attrsExpected attrsExisting)
56 folder (attrExpected, attrExisting) expr = if attrExpected == attrExisting then
57 expr
58 else
59 Rename attrExisting attrExpected expr
61-- if the constraint is a foreign key constraint, then return the relations and attributes involved - this only detects foreign keys created with `databaseContextExprForForeignKey`
62isForeignKeyFor :: InclusionDependency -> (RelVarName, [AttributeName]) -> (RelVarName, [AttributeName]) -> Bool
63isForeignKeyFor incDep infoA infoB = incDep == checkIncDep
64 where
65 checkIncDep = inclusionDependencyForForeignKey infoA infoB