module ProjectM36.Key where
import ProjectM36.Base
import ProjectM36.Relation
import qualified Data.Set as S
import qualified Data.Text as T
#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 (forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
relationFalse)
  where 
    projectedOnKeys :: RelationalExpr -> RelationalExpr
projectedOnKeys = forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project AttributeNames
attrNames
    exprAsSubRelation :: RelationalExprBase a -> RelationalExprBase a
exprAsSubRelation RelationalExprBase a
expr = forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend (forall a. IncDepName -> AtomExprBase a -> ExtendTupleExprBase a
AttributeExtendTupleExpr IncDepName
"a" (forall a. RelationalExprBase a -> AtomExprBase a
RelationAtomExpr RelationalExprBase a
expr)) (forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
relationTrue)
    exprCount :: RelationalExpr -> RelationalExpr
exprCount RelationalExpr
expr = forall {a}. RelationalExprBase a -> RelationalExprBase a
projectionForCount (forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend (forall a. IncDepName -> AtomExprBase a -> ExtendTupleExprBase a
AttributeExtendTupleExpr IncDepName
"b" (forall a. IncDepName -> [AtomExprBase a] -> a -> AtomExprBase a
FunctionAtomExpr IncDepName
"count" [forall a. IncDepName -> AtomExprBase a
AttributeAtomExpr IncDepName
"a"] () )) (forall {a}. RelationalExprBase a -> RelationalExprBase a
exprAsSubRelation RelationalExpr
expr))
    projectionForCount :: RelationalExprBase a -> RelationalExprBase a
projectionForCount = forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project (forall a. Set IncDepName -> AttributeNamesBase a
AttributeNames forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
S.fromList [IncDepName
"b"])
    equalityExpr :: RelationalExpr
equalityExpr = 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 :: IncDepName -> [IncDepName] -> DatabaseContextExpr
databaseContextExprForUniqueKey IncDepName
rvName [IncDepName]
attrNames = forall a.
IncDepName -> InclusionDependency -> DatabaseContextExprBase a
AddInclusionDependency (IncDepName
rvName forall a. Semigroup a => a -> a -> a
<> IncDepName
"_" forall a. Semigroup a => a -> a -> a
<> IncDepName
cols forall a. Semigroup a => a -> a -> a
<>  IncDepName
"_key") forall a b. (a -> b) -> a -> b
$ AttributeNames -> RelationalExpr -> InclusionDependency
inclusionDependencyForKey (forall a. Set IncDepName -> AttributeNamesBase a
AttributeNames (forall a. Ord a => [a] -> Set a
S.fromList [IncDepName]
attrNames)) (forall a. IncDepName -> a -> RelationalExprBase a
RelationVariable IncDepName
rvName ())
  where
    cols :: IncDepName
cols = IncDepName -> [IncDepName] -> IncDepName
T.intercalate IncDepName
"_" [IncDepName]
attrNames

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