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 (Text, InclusionDependency) -> [Atom]
incDepAsAtoms (forall k a. Map k a -> [(k, a)]
M.toList InclusionDependencies
incDeps))
  where
    attrs :: Attributes
attrs = [Attribute] -> Attributes
attributesFromList [Text -> AtomType -> Attribute
Attribute Text
"name" AtomType
TextAtomType,
                                Text -> AtomType -> Attribute
Attribute Text
"sub" AtomType
RelationalExprAtomType,
                                Text -> AtomType -> Attribute
Attribute Text
"super" AtomType
RelationalExprAtomType
                                ]
    incDepAsAtoms :: (Text, InclusionDependency) -> [Atom]
incDepAsAtoms (Text
name, InclusionDependency RelationalExpr
exprA RelationalExpr
exprB) = [Text -> Atom
TextAtom Text
name,
                                                             RelationalExpr -> Atom
RelationalExprAtom RelationalExpr
exprA,
                                                             RelationalExpr -> Atom
RelationalExprAtom RelationalExpr
exprB]