module ProjectM36.InclusionDependency where
import ProjectM36.Base
import ProjectM36.Attribute
import ProjectM36.Error
import ProjectM36.Relation
import qualified Data.Map as M

inclusionDependenciesAsRelation :: InclusionDependencies -> Either RelationalError Relation
inclusionDependenciesAsRelation :: InclusionDependencies -> Either RelationalError Relation
inclusionDependenciesAsRelation InclusionDependencies
incDeps =
  Attributes -> [[Atom]] -> Either RelationalError Relation
mkRelationFromList Attributes
attrs (forall a b. (a -> b) -> [a] -> [b]
map (AttributeName, InclusionDependency) -> [Atom]
incDepAsAtoms (forall k a. Map k a -> [(k, a)]
M.toList InclusionDependencies
incDeps))
  where
    attrs :: Attributes
attrs = [Attribute] -> Attributes
attributesFromList [AttributeName -> AtomType -> Attribute
Attribute AttributeName
"name" AtomType
TextAtomType,
                                AttributeName -> AtomType -> Attribute
Attribute AttributeName
"sub" AtomType
RelationalExprAtomType,
                                AttributeName -> AtomType -> Attribute
Attribute AttributeName
"super" AtomType
RelationalExprAtomType
                                ]
    incDepAsAtoms :: (AttributeName, InclusionDependency) -> [Atom]
incDepAsAtoms (AttributeName
name, InclusionDependency RelationalExpr
exprA RelationalExpr
exprB) = [AttributeName -> Atom
TextAtom AttributeName
name,
                                                             RelationalExpr -> Atom
RelationalExprAtom RelationalExpr
exprA,
                                                             RelationalExpr -> Atom
RelationalExprAtom RelationalExpr
exprB]

-- validate that the given AtomExpr is true for an relvar
inclusionDependencyForAtomExpr :: RelVarName -> AtomExpr -> InclusionDependency
inclusionDependencyForAtomExpr :: AttributeName -> AtomExpr -> InclusionDependency
inclusionDependencyForAtomExpr AttributeName
rvname AtomExpr
atomExpr =
  RelationalExpr -> RelationalExpr -> InclusionDependency
InclusionDependency
  (forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
NotEquals (forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
relationTrue)
    (forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project (forall a. Set AttributeName -> AttributeNamesBase a
AttributeNames forall a. Monoid a => a
mempty) (forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict RestrictionPredicateExprBase ()
check (forall a. AttributeName -> a -> RelationalExprBase a
RelationVariable AttributeName
rvname ())))
  )
  (forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
relationFalse)
  where
    check :: RestrictionPredicateExprBase ()
check = forall a. AtomExprBase a -> RestrictionPredicateExprBase a
AtomExprPredicate AtomExpr
atomExpr