module ProjectM36.FunctionalDependency where
import ProjectM36.Base 
import qualified Data.Set as S

data FunctionalDependency = FunctionalDependency AttributeNames AttributeNames RelationalExpr

--(s{city} group ({city} as x) : {z:=count(@x)}) {z}
-- as defined in Relational Algebra and All That Jazz page 21
inclusionDependenciesForFunctionalDependency :: FunctionalDependency -> (InclusionDependency, InclusionDependency)
inclusionDependenciesForFunctionalDependency :: FunctionalDependency -> (InclusionDependency, InclusionDependency)
inclusionDependenciesForFunctionalDependency (FunctionalDependency AttributeNames
attrNamesSource AttributeNames
attrNamesDependent RelationalExpr
relExpr) = (
  RelationalExpr -> RelationalExpr -> InclusionDependency
InclusionDependency RelationalExpr
countSource RelationalExpr
countDep,            
  RelationalExpr -> RelationalExpr -> InclusionDependency
InclusionDependency RelationalExpr
countDep RelationalExpr
countSource)
  where
    countDep :: RelationalExpr
countDep = RelationalExpr -> AttributeNames -> RelationalExpr
relExprCount RelationalExpr
relExpr (AttributeNames -> AttributeNames -> AttributeNames
forall a.
AttributeNamesBase a
-> AttributeNamesBase a -> AttributeNamesBase a
UnionAttributeNames AttributeNames
attrNamesSource AttributeNames
attrNamesDependent)
    countSource :: RelationalExpr
countSource = RelationalExpr -> AttributeNames -> RelationalExpr
relExprCount RelationalExpr
relExpr AttributeNames
attrNamesSource
    projectZName :: RelationalExprBase a -> RelationalExprBase a
projectZName = 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 (AttributeName -> Set AttributeName
forall a. a -> Set a
S.singleton AttributeName
"z"))
    zCount :: AtomExprBase ()
zCount = AttributeName -> [AtomExprBase ()] -> () -> AtomExprBase ()
forall a. AttributeName -> [AtomExprBase a] -> a -> AtomExprBase a
FunctionAtomExpr AttributeName
"count" [AttributeName -> AtomExprBase ()
forall a. AttributeName -> AtomExprBase a
AttributeAtomExpr AttributeName
"x"] ()
    extendZName :: RelationalExpr -> RelationalExpr
extendZName = ExtendTupleExprBase () -> RelationalExpr -> RelationalExpr
forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend (AttributeName -> AtomExprBase () -> ExtendTupleExprBase ()
forall a. AttributeName -> AtomExprBase a -> ExtendTupleExprBase a
AttributeExtendTupleExpr AttributeName
"z" AtomExprBase ()
zCount)
    relExprCount :: RelationalExpr -> AttributeNames -> RelationalExpr
relExprCount RelationalExpr
expr AttributeNames
projectionAttrNames = RelationalExpr -> RelationalExpr
forall a. RelationalExprBase a -> RelationalExprBase a
projectZName (RelationalExpr -> RelationalExpr
extendZName
       (AttributeNames -> AttributeName -> RelationalExpr -> RelationalExpr
forall a.
AttributeNamesBase a
-> AttributeName -> RelationalExprBase a -> RelationalExprBase a
Group AttributeNames
projectionAttrNames AttributeName
"x" (AttributeNames -> RelationalExpr -> RelationalExpr
forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project AttributeNames
projectionAttrNames RelationalExpr
expr)))