on 52182bc help sign in
project-m36/src/lib/ProjectM36/DateExamples.hs
90 lines 4.4 kB history raw
1module ProjectM36.DateExamples where
2import ProjectM36.Base
3import qualified ProjectM36.Attribute as A
4import ProjectM36.Key
5import ProjectM36.AtomFunctions.Basic
6import ProjectM36.DataTypes.Basic
7import ProjectM36.DatabaseContext
8import ProjectM36.Relation
9import qualified Data.Map as M
10import qualified Data.Set as S
12dateExamples :: DatabaseContext
13dateExamples = empty { inclusionDependencies = dateIncDeps,
14 relationVariables = M.union (relationVariables basicDatabaseContext) dateRelVars,
15 notifications = M.empty,
16 atomFunctions = basicAtomFunctions,
17 typeConstructorMapping = basicTypeConstructorMapping }
18 where -- these must be lower case now that data constructors are in play
19 dateRelVars = M.fromList [("s", suppliers),
20 ("p", products),
21 ("sp", supplierProducts)]
22 suppliers = suppliersRel
23 products = productsRel
24 supplierProducts = supplierProductsRel
25 dateIncDeps = M.fromList [
26 ("s_pkey", simplePKey ["s#"] "s"),
27 ("p_pkey", simplePKey ["p#"] "p"),
28 ("sp_pkey", simplePKey ["s#", "p#"] "sp"),
29 ("s_sp_fk", inclusionDependencyForForeignKey ("sp", ["s#"]) ("s", ["s#"])),
30 ("p_sp_fk", inclusionDependencyForForeignKey ("sp", ["p#"]) ("p", ["p#"]))
31 ]
32 simplePKey attrNames relvarName = inclusionDependencyForKey (AttributeNames $ S.fromList attrNames) (RelationVariable relvarName ())
34suppliersRel :: Relation
35suppliersRel = case mkRelationFromList attrs atomMatrix of
36 Left _ -> undefined
37 Right rel -> rel
38 where
39 attrs = A.attributesFromList [Attribute "s#" TextAtomType,
40 Attribute "sname" TextAtomType,
41 Attribute "status" IntegerAtomType,
42 Attribute "city" TextAtomType]
43 atomMatrix = [
44 [TextAtom "S1", TextAtom "Smith", IntegerAtom 20, TextAtom "London"],
45 [TextAtom "S2", TextAtom "Jones", IntegerAtom 10, TextAtom "Paris"],
46 [TextAtom "S3", TextAtom "Blake", IntegerAtom 30, TextAtom "Paris"],
47 [TextAtom "S4", TextAtom "Clark", IntegerAtom 20, TextAtom "London"],
48 [TextAtom "S5", TextAtom "Adams", IntegerAtom 30, TextAtom "Athens"]]
50supplierProductsRel :: Relation
51supplierProductsRel = case mkRelationFromList attrs matrix of
52 Left _ -> undefined
53 Right rel -> rel
54 where
55 attrs = A.attributesFromList [Attribute "s#" TextAtomType,
56 Attribute "p#" TextAtomType,
57 Attribute "qty" IntegerAtomType]
58 matrix = [
59 [TextAtom "S1", TextAtom "P1", IntegerAtom 300],
60 [TextAtom "S1", TextAtom "P2", IntegerAtom 200],
61 [TextAtom "S1", TextAtom "P3", IntegerAtom 400],
62 [TextAtom "S1", TextAtom "P4", IntegerAtom 200],
63 [TextAtom "S1", TextAtom "P5", IntegerAtom 100],
64 [TextAtom "S1", TextAtom "P6", IntegerAtom 100],
65 [TextAtom "S2", TextAtom "P1", IntegerAtom 300],
66 [TextAtom "S2", TextAtom "P2", IntegerAtom 400],
67 [TextAtom "S3", TextAtom "P2", IntegerAtom 200],
68 [TextAtom "S4", TextAtom "P2", IntegerAtom 200],
69 [TextAtom "S4", TextAtom "P4", IntegerAtom 300],
70 [TextAtom "S4", TextAtom "P5", IntegerAtom 400]
71 ]
73productsRel :: Relation
74productsRel = case mkRelationFromList attrs matrix of
75 Left _ -> undefined
76 Right rel -> rel
77 where
78 attrs = A.attributesFromList [Attribute "p#" TextAtomType,
79 Attribute "pname" TextAtomType,
80 Attribute "color" TextAtomType,
81 Attribute "weight" IntegerAtomType,
82 Attribute "city" TextAtomType]
83 matrix = [
84 [TextAtom "P1", TextAtom "Nut", TextAtom "Red", IntegerAtom 12, TextAtom "London"],
85 [TextAtom "P2", TextAtom "Bolt", TextAtom "Green", IntegerAtom 17, TextAtom "Paris"],
86 [TextAtom "P3", TextAtom "Screw", TextAtom "Blue", IntegerAtom 17, TextAtom "Oslo"],
87 [TextAtom "P4", TextAtom "Screw", TextAtom "Red", IntegerAtom 14, TextAtom "London"],
88 [TextAtom "P5", TextAtom "Cam", TextAtom "Blue", IntegerAtom 12, TextAtom "Paris"],
89 [TextAtom "P6", TextAtom "Cog", TextAtom "Red", IntegerAtom 19, TextAtom "London"]
90 ]