module ProjectM36.Key where
import ProjectM36.Base
import ProjectM36.Relation
import qualified Data.Set as S
#if __GLASGOW_HASKELL__ < 804
import Data.Monoid
#endif

{-
keys 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

example: 
:showexpr ((relation{tuple{}}:{a:=S}):{b:=count(@a)}){b}
┌─┐
│b│
├─┤
│5│
└─┘
((relation{tuple{}}:{a:=S{S#}}):{b:=count(@a)}){b}
┌─┐
│b│
├─┤
│5│
└─┘
-}

-- | Create a uniqueness constraint for the attribute names and relational expression. Note that constraint can span multiple relation variables.
inclusionDependencyForKey :: AttributeNames -> RelationalExpr -> InclusionDependency
inclusionDependencyForKey :: AttributeNames -> RelationalExpr -> InclusionDependency
inclusionDependencyForKey AttributeNames
attrNames RelationalExpr
relExpr = --InclusionDependency name (exprCount relExpr) (exprCount (projectedOnKeys relExpr))
 RelationalExpr -> RelationalExpr -> InclusionDependency
InclusionDependency RelationalExpr
equalityExpr (Relation -> RelationalExpr
forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
relationFalse)
  where 
    projectedOnKeys :: RelationalExpr -> RelationalExpr
projectedOnKeys = AttributeNames -> RelationalExpr -> RelationalExpr
forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project AttributeNames
attrNames
    exprAsSubRelation :: RelationalExprBase a -> RelationalExprBase a
exprAsSubRelation RelationalExprBase a
expr = ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend (AttributeName -> AtomExprBase a -> ExtendTupleExprBase a
forall a. AttributeName -> AtomExprBase a -> ExtendTupleExprBase a
AttributeExtendTupleExpr AttributeName
"a" (RelationalExprBase a -> AtomExprBase a
forall a. RelationalExprBase a -> AtomExprBase a
RelationAtomExpr RelationalExprBase a
expr)) (Relation -> RelationalExprBase a
forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
relationTrue)
    exprCount :: RelationalExpr -> RelationalExpr
exprCount RelationalExpr
expr = RelationalExpr -> RelationalExpr
forall a. RelationalExprBase a -> RelationalExprBase a
projectionForCount (ExtendTupleExprBase () -> RelationalExpr -> RelationalExpr
forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend (AttributeName -> AtomExprBase () -> ExtendTupleExprBase ()
forall a. AttributeName -> AtomExprBase a -> ExtendTupleExprBase a
AttributeExtendTupleExpr AttributeName
"b" (AttributeName -> [AtomExprBase ()] -> () -> AtomExprBase ()
forall a. AttributeName -> [AtomExprBase a] -> a -> AtomExprBase a
FunctionAtomExpr AttributeName
"count" [AttributeName -> AtomExprBase ()
forall a. AttributeName -> AtomExprBase a
AttributeAtomExpr AttributeName
"a"] () )) (RelationalExpr -> RelationalExpr
forall a. RelationalExprBase a -> RelationalExprBase a
exprAsSubRelation RelationalExpr
expr))
    projectionForCount :: RelationalExprBase a -> RelationalExprBase a
projectionForCount = AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project (Set AttributeName -> AttributeNamesBase a
forall a. Set AttributeName -> AttributeNamesBase a
AttributeNames (Set AttributeName -> AttributeNamesBase a)
-> Set AttributeName -> AttributeNamesBase a
forall a b. (a -> b) -> a -> b
$ [AttributeName] -> Set AttributeName
forall a. Ord a => [a] -> Set a
S.fromList [AttributeName
"b"])
    equalityExpr :: RelationalExpr
equalityExpr = RelationalExpr -> RelationalExpr -> RelationalExpr
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
NotEquals (RelationalExpr -> RelationalExpr
exprCount RelationalExpr
relExpr) (RelationalExpr -> RelationalExpr
exprCount (RelationalExpr -> RelationalExpr
projectedOnKeys RelationalExpr
relExpr))

-- | Create a 'DatabaseContextExpr' which can be used to add a uniqueness constraint to attributes on one relation variable.
databaseContextExprForUniqueKey :: RelVarName -> [AttributeName] -> DatabaseContextExpr
databaseContextExprForUniqueKey :: AttributeName -> [AttributeName] -> DatabaseContextExpr
databaseContextExprForUniqueKey AttributeName
rvName [AttributeName]
attrNames = AttributeName -> InclusionDependency -> DatabaseContextExpr
forall a.
AttributeName -> InclusionDependency -> DatabaseContextExprBase a
AddInclusionDependency (AttributeName
rvName AttributeName -> AttributeName -> AttributeName
forall a. Semigroup a => a -> a -> a
<> AttributeName
"_key") (InclusionDependency -> DatabaseContextExpr)
-> InclusionDependency -> DatabaseContextExpr
forall a b. (a -> b) -> a -> b
$ AttributeNames -> RelationalExpr -> InclusionDependency
inclusionDependencyForKey (Set AttributeName -> AttributeNames
forall a. Set AttributeName -> AttributeNamesBase a
AttributeNames ([AttributeName] -> Set AttributeName
forall a. Ord a => [a] -> Set a
S.fromList [AttributeName]
attrNames)) (AttributeName -> () -> RelationalExpr
forall a. AttributeName -> a -> RelationalExprBase a
RelationVariable AttributeName
rvName ())

-- | Create a foreign key constraint from the first relation variable and attributes to the second.
databaseContextExprForForeignKey :: IncDepName -> (RelVarName, [AttributeName]) -> (RelVarName, [AttributeName]) -> DatabaseContextExpr
databaseContextExprForForeignKey :: AttributeName
-> (AttributeName, [AttributeName])
-> (AttributeName, [AttributeName])
-> DatabaseContextExpr
databaseContextExprForForeignKey AttributeName
fkName (AttributeName, [AttributeName])
infoA (AttributeName, [AttributeName])
infoB =
  AttributeName -> InclusionDependency -> DatabaseContextExpr
forall a.
AttributeName -> InclusionDependency -> DatabaseContextExprBase a
AddInclusionDependency AttributeName
fkName ((AttributeName, [AttributeName])
-> (AttributeName, [AttributeName]) -> InclusionDependency
inclusionDependencyForForeignKey (AttributeName, [AttributeName])
infoA (AttributeName, [AttributeName])
infoB)
  
inclusionDependencyForForeignKey :: (RelVarName, [AttributeName]) -> (RelVarName, [AttributeName]) -> InclusionDependency
inclusionDependencyForForeignKey :: (AttributeName, [AttributeName])
-> (AttributeName, [AttributeName]) -> InclusionDependency
inclusionDependencyForForeignKey (AttributeName
rvA, [AttributeName]
attrsA) (AttributeName
rvB, [AttributeName]
attrsB) = 
  RelationalExpr -> RelationalExpr -> InclusionDependency
InclusionDependency (
    [AttributeName]
-> [AttributeName] -> RelationalExpr -> RelationalExpr
forall a.
[AttributeName]
-> [AttributeName] -> RelationalExprBase a -> RelationalExprBase a
renameIfNecessary [AttributeName]
attrsB [AttributeName]
attrsA (AttributeNames -> RelationalExpr -> RelationalExpr
forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project ([AttributeName] -> AttributeNames
forall a. [AttributeName] -> AttributeNamesBase a
attrsL [AttributeName]
attrsA)
                                     (AttributeName -> () -> RelationalExpr
forall a. AttributeName -> a -> RelationalExprBase a
RelationVariable AttributeName
rvA ()))) (
    AttributeNames -> RelationalExpr -> RelationalExpr
forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project ([AttributeName] -> AttributeNames
forall a. [AttributeName] -> AttributeNamesBase a
attrsL [AttributeName]
attrsB) (AttributeName -> () -> RelationalExpr
forall a. AttributeName -> a -> RelationalExprBase a
RelationVariable AttributeName
rvB ()))
  where
    attrsL :: [AttributeName] -> AttributeNamesBase a
attrsL = Set AttributeName -> AttributeNamesBase a
forall a. Set AttributeName -> AttributeNamesBase a
AttributeNames (Set AttributeName -> AttributeNamesBase a)
-> ([AttributeName] -> Set AttributeName)
-> [AttributeName]
-> AttributeNamesBase a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AttributeName] -> Set AttributeName
forall a. Ord a => [a] -> Set a
S.fromList    
    renameIfNecessary :: [AttributeName]
-> [AttributeName] -> RelationalExprBase a -> RelationalExprBase a
renameIfNecessary [AttributeName]
attrsExpected [AttributeName]
attrsExisting RelationalExprBase a
expr = ((AttributeName, AttributeName)
 -> RelationalExprBase a -> RelationalExprBase a)
-> RelationalExprBase a
-> [(AttributeName, AttributeName)]
-> RelationalExprBase a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (AttributeName, AttributeName)
-> RelationalExprBase a -> RelationalExprBase a
forall a.
(AttributeName, AttributeName)
-> RelationalExprBase a -> RelationalExprBase a
folder RelationalExprBase a
expr ([AttributeName]
-> [AttributeName] -> [(AttributeName, AttributeName)]
forall a b. [a] -> [b] -> [(a, b)]
zip [AttributeName]
attrsExpected [AttributeName]
attrsExisting)
    folder :: (AttributeName, AttributeName)
-> RelationalExprBase a -> RelationalExprBase a
folder (AttributeName
attrExpected, AttributeName
attrExisting) RelationalExprBase a
expr = if AttributeName
attrExpected AttributeName -> AttributeName -> Bool
forall a. Eq a => a -> a -> Bool
== AttributeName
attrExisting then
                                                   RelationalExprBase a
expr
                                                 else
                                                   AttributeName
-> AttributeName -> RelationalExprBase a -> RelationalExprBase a
forall a.
AttributeName
-> AttributeName -> RelationalExprBase a -> RelationalExprBase a
Rename AttributeName
attrExisting AttributeName
attrExpected RelationalExprBase a
expr

-- if the constraint is a foreign key constraint, then return the relations and attributes involved - this only detects foreign keys created with `databaseContextExprForForeignKey`
isForeignKeyFor :: InclusionDependency -> (RelVarName, [AttributeName]) -> (RelVarName, [AttributeName]) -> Bool
isForeignKeyFor :: InclusionDependency
-> (AttributeName, [AttributeName])
-> (AttributeName, [AttributeName])
-> Bool
isForeignKeyFor InclusionDependency
incDep (AttributeName, [AttributeName])
infoA (AttributeName, [AttributeName])
infoB = InclusionDependency
incDep InclusionDependency -> InclusionDependency -> Bool
forall a. Eq a => a -> a -> Bool
== InclusionDependency
checkIncDep
  where
    checkIncDep :: InclusionDependency
checkIncDep = (AttributeName, [AttributeName])
-> (AttributeName, [AttributeName]) -> InclusionDependency
inclusionDependencyForForeignKey (AttributeName, [AttributeName])
infoA (AttributeName, [AttributeName])
infoB