module ProjectM36.DateExamples where
import ProjectM36.Base
import qualified ProjectM36.Attribute as A
import ProjectM36.Key
import ProjectM36.AtomFunctions.Basic
import ProjectM36.DataTypes.Basic
import ProjectM36.DatabaseContext
import ProjectM36.Relation
import qualified Data.Map as M
import qualified Data.Set as S

dateExamples :: DatabaseContext
dateExamples :: DatabaseContext
dateExamples = DatabaseContext
empty { inclusionDependencies :: InclusionDependencies
inclusionDependencies = InclusionDependencies
dateIncDeps,
                                 relationVariables :: RelationVariables
relationVariables = forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (DatabaseContext -> RelationVariables
relationVariables DatabaseContext
basicDatabaseContext) forall {a}. Map RelVarName (RelationalExprBase a)
dateRelVars,
                                 notifications :: Notifications
notifications = forall k a. Map k a
M.empty,
                                 atomFunctions :: AtomFunctions
atomFunctions = AtomFunctions
basicAtomFunctions,
                                 typeConstructorMapping :: TypeConstructorMapping
typeConstructorMapping = TypeConstructorMapping
basicTypeConstructorMapping }
  where -- these must be lower case now that data constructors are in play
    dateRelVars :: Map RelVarName (RelationalExprBase a)
dateRelVars = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(RelVarName
"s", forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
suppliers),
                              (RelVarName
"p", forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
products),
                              (RelVarName
"sp", forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
supplierProducts)]
    suppliers :: Relation
suppliers = Relation
suppliersRel
    products :: Relation
products = Relation
productsRel
    supplierProducts :: Relation
supplierProducts = Relation
supplierProductsRel
    dateIncDeps :: InclusionDependencies
dateIncDeps = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
      (RelVarName
"s_pkey", [RelVarName] -> RelVarName -> InclusionDependency
simplePKey [RelVarName
"s#"] RelVarName
"s"),
      (RelVarName
"p_pkey", [RelVarName] -> RelVarName -> InclusionDependency
simplePKey [RelVarName
"p#"] RelVarName
"p"),
      (RelVarName
"sp_pkey", [RelVarName] -> RelVarName -> InclusionDependency
simplePKey [RelVarName
"s#", RelVarName
"p#"] RelVarName
"sp"),
      (RelVarName
"s_sp_fk", (RelVarName, [RelVarName])
-> (RelVarName, [RelVarName]) -> InclusionDependency
inclusionDependencyForForeignKey (RelVarName
"sp", [RelVarName
"s#"]) (RelVarName
"s", [RelVarName
"s#"])),
      (RelVarName
"p_sp_fk", (RelVarName, [RelVarName])
-> (RelVarName, [RelVarName]) -> InclusionDependency
inclusionDependencyForForeignKey (RelVarName
"sp", [RelVarName
"p#"]) (RelVarName
"p", [RelVarName
"p#"]))
      ]
    simplePKey :: [RelVarName] -> RelVarName -> InclusionDependency
simplePKey [RelVarName]
attrNames RelVarName
relvarName = AttributeNames -> RelationalExpr -> InclusionDependency
inclusionDependencyForKey (forall a. Set RelVarName -> AttributeNamesBase a
AttributeNames forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
S.fromList [RelVarName]
attrNames) (forall a. RelVarName -> a -> RelationalExprBase a
RelationVariable RelVarName
relvarName ())

suppliersRel :: Relation
suppliersRel :: Relation
suppliersRel = case Attributes -> [[Atom]] -> Either RelationalError Relation
mkRelationFromList Attributes
attrs [[Atom]]
atomMatrix of
  Left RelationalError
_ -> forall a. HasCallStack => a
undefined
  Right Relation
rel -> Relation
rel
  where
    attrs :: Attributes
attrs = [Attribute] -> Attributes
A.attributesFromList [RelVarName -> AtomType -> Attribute
Attribute RelVarName
"s#" AtomType
TextAtomType,
                                  RelVarName -> AtomType -> Attribute
Attribute RelVarName
"sname" AtomType
TextAtomType,
                                  RelVarName -> AtomType -> Attribute
Attribute RelVarName
"status" AtomType
IntegerAtomType,
                                  RelVarName -> AtomType -> Attribute
Attribute RelVarName
"city" AtomType
TextAtomType]
    atomMatrix :: [[Atom]]
atomMatrix = [
      [RelVarName -> Atom
TextAtom RelVarName
"S1", RelVarName -> Atom
TextAtom RelVarName
"Smith", Integer -> Atom
IntegerAtom Integer
20, RelVarName -> Atom
TextAtom RelVarName
"London"],
      [RelVarName -> Atom
TextAtom RelVarName
"S2", RelVarName -> Atom
TextAtom RelVarName
"Jones", Integer -> Atom
IntegerAtom Integer
10, RelVarName -> Atom
TextAtom RelVarName
"Paris"],
      [RelVarName -> Atom
TextAtom RelVarName
"S3", RelVarName -> Atom
TextAtom RelVarName
"Blake", Integer -> Atom
IntegerAtom Integer
30, RelVarName -> Atom
TextAtom RelVarName
"Paris"],
      [RelVarName -> Atom
TextAtom RelVarName
"S4", RelVarName -> Atom
TextAtom RelVarName
"Clark", Integer -> Atom
IntegerAtom Integer
20, RelVarName -> Atom
TextAtom RelVarName
"London"],
      [RelVarName -> Atom
TextAtom RelVarName
"S5", RelVarName -> Atom
TextAtom RelVarName
"Adams", Integer -> Atom
IntegerAtom Integer
30, RelVarName -> Atom
TextAtom RelVarName
"Athens"]]

supplierProductsRel :: Relation
supplierProductsRel :: Relation
supplierProductsRel = case Attributes -> [[Atom]] -> Either RelationalError Relation
mkRelationFromList Attributes
attrs [[Atom]]
matrix of
  Left RelationalError
_ -> forall a. HasCallStack => a
undefined
  Right Relation
rel -> Relation
rel
  where
    attrs :: Attributes
attrs = [Attribute] -> Attributes
A.attributesFromList [RelVarName -> AtomType -> Attribute
Attribute RelVarName
"s#" AtomType
TextAtomType,
                                  RelVarName -> AtomType -> Attribute
Attribute RelVarName
"p#" AtomType
TextAtomType,
                                  RelVarName -> AtomType -> Attribute
Attribute RelVarName
"qty" AtomType
IntegerAtomType]
    matrix :: [[Atom]]
matrix = [
      [RelVarName -> Atom
TextAtom RelVarName
"S1", RelVarName -> Atom
TextAtom RelVarName
"P1", Integer -> Atom
IntegerAtom Integer
300],
      [RelVarName -> Atom
TextAtom RelVarName
"S1", RelVarName -> Atom
TextAtom RelVarName
"P2", Integer -> Atom
IntegerAtom Integer
200],
      [RelVarName -> Atom
TextAtom RelVarName
"S1", RelVarName -> Atom
TextAtom RelVarName
"P3", Integer -> Atom
IntegerAtom Integer
400],
      [RelVarName -> Atom
TextAtom RelVarName
"S1", RelVarName -> Atom
TextAtom RelVarName
"P4", Integer -> Atom
IntegerAtom Integer
200],
      [RelVarName -> Atom
TextAtom RelVarName
"S1", RelVarName -> Atom
TextAtom RelVarName
"P5", Integer -> Atom
IntegerAtom Integer
100],
      [RelVarName -> Atom
TextAtom RelVarName
"S1", RelVarName -> Atom
TextAtom RelVarName
"P6", Integer -> Atom
IntegerAtom Integer
100],
      [RelVarName -> Atom
TextAtom RelVarName
"S2", RelVarName -> Atom
TextAtom RelVarName
"P1", Integer -> Atom
IntegerAtom Integer
300],
      [RelVarName -> Atom
TextAtom RelVarName
"S2", RelVarName -> Atom
TextAtom RelVarName
"P2", Integer -> Atom
IntegerAtom Integer
400],
      [RelVarName -> Atom
TextAtom RelVarName
"S3", RelVarName -> Atom
TextAtom RelVarName
"P2", Integer -> Atom
IntegerAtom Integer
200],
      [RelVarName -> Atom
TextAtom RelVarName
"S4", RelVarName -> Atom
TextAtom RelVarName
"P2", Integer -> Atom
IntegerAtom Integer
200],
      [RelVarName -> Atom
TextAtom RelVarName
"S4", RelVarName -> Atom
TextAtom RelVarName
"P4", Integer -> Atom
IntegerAtom Integer
300],
      [RelVarName -> Atom
TextAtom RelVarName
"S4", RelVarName -> Atom
TextAtom RelVarName
"P5", Integer -> Atom
IntegerAtom Integer
400]
      ]

productsRel :: Relation
productsRel :: Relation
productsRel = case Attributes -> [[Atom]] -> Either RelationalError Relation
mkRelationFromList Attributes
attrs [[Atom]]
matrix of
  Left RelationalError
_ -> forall a. HasCallStack => a
undefined
  Right Relation
rel -> Relation
rel
  where
    attrs :: Attributes
attrs = [Attribute] -> Attributes
A.attributesFromList [RelVarName -> AtomType -> Attribute
Attribute RelVarName
"p#" AtomType
TextAtomType,
                                  RelVarName -> AtomType -> Attribute
Attribute RelVarName
"pname" AtomType
TextAtomType,
                                  RelVarName -> AtomType -> Attribute
Attribute RelVarName
"color" AtomType
TextAtomType,
                                  RelVarName -> AtomType -> Attribute
Attribute RelVarName
"weight" AtomType
IntegerAtomType,
                                  RelVarName -> AtomType -> Attribute
Attribute RelVarName
"city" AtomType
TextAtomType]
    matrix :: [[Atom]]
matrix = [
      [RelVarName -> Atom
TextAtom RelVarName
"P1", RelVarName -> Atom
TextAtom RelVarName
"Nut", RelVarName -> Atom
TextAtom RelVarName
"Red", Integer -> Atom
IntegerAtom Integer
12, RelVarName -> Atom
TextAtom RelVarName
"London"],
      [RelVarName -> Atom
TextAtom RelVarName
"P2", RelVarName -> Atom
TextAtom RelVarName
"Bolt", RelVarName -> Atom
TextAtom RelVarName
"Green", Integer -> Atom
IntegerAtom Integer
17, RelVarName -> Atom
TextAtom RelVarName
"Paris"],
      [RelVarName -> Atom
TextAtom RelVarName
"P3", RelVarName -> Atom
TextAtom RelVarName
"Screw", RelVarName -> Atom
TextAtom RelVarName
"Blue", Integer -> Atom
IntegerAtom Integer
17, RelVarName -> Atom
TextAtom RelVarName
"Oslo"],
      [RelVarName -> Atom
TextAtom RelVarName
"P4", RelVarName -> Atom
TextAtom RelVarName
"Screw", RelVarName -> Atom
TextAtom RelVarName
"Red", Integer -> Atom
IntegerAtom Integer
14, RelVarName -> Atom
TextAtom RelVarName
"London"],
      [RelVarName -> Atom
TextAtom RelVarName
"P5", RelVarName -> Atom
TextAtom RelVarName
"Cam", RelVarName -> Atom
TextAtom RelVarName
"Blue", Integer -> Atom
IntegerAtom Integer
12, RelVarName -> Atom
TextAtom RelVarName
"Paris"],
      [RelVarName -> Atom
TextAtom RelVarName
"P6", RelVarName -> Atom
TextAtom RelVarName
"Cog", RelVarName -> Atom
TextAtom RelVarName
"Red", Integer -> Atom
IntegerAtom Integer
19, RelVarName -> Atom
TextAtom RelVarName
"London"]
      ]