@@ -1,154 +1,80 @@
1−{-# LANGUAGE GADTs #-}
21module RelationExpr where
32import Relation
43import RelationTuple
4+import RelationTupleSet
55import RelationType
66import RelationalError
7−import qualified Data.Set as S
87import qualified Data.Map as M
98import qualified Data.HashSet as HS
109import Control.Monad.State hiding (join)
1110
12−type RelVarContext = M.Map String Relation
13−
14−type AtomName = String
15−
16−data RelationalExpr where
17− MakeStaticRelation :: Attributes -> RelationTupleSet -> RelationalExpr
18− --MakeFunctionalRelation (creates a relation from a tuple-generating function, potentially infinite)
19− --in Tutorial D, relational variables pick up the type of the first relation assigned to them
20− --relational variables should also be able to be explicitly-typed like in Haskell
21− RelationVariable :: String -> RelationalExpr
22− Project :: S.Set AttributeName -> RelationalExpr -> RelationalExpr
23− Union :: RelationalExpr -> RelationalExpr -> RelationalExpr
24− Join :: RelationalExpr -> RelationalExpr -> RelationalExpr
25− MultipleExpr :: [RelationalExpr] -> RelationalExpr
26− Rename :: AttributeName -> AttributeName -> RelationalExpr -> RelationalExpr
27− Group :: S.Set AttributeName -> AttributeName -> RelationalExpr -> RelationalExpr
28− Ungroup :: AttributeName -> RelationalExpr -> RelationalExpr
29− --Restrict :: RExpr.RestrictionExpr -> RelationalExpr -> RelationalExpr
30−
31− --nominal relational expressions- the following operations could also be deemed non-relational, but I allow them to return relational expressions regardless- maybe this doesn't make sense since they should only be allowed as top-level commands
32− Define :: String -> Attributes -> RelationalExpr
33− Assign :: String -> RelationalExpr -> RelationalExpr
34− Insert :: String -> RelationalExpr -> RelationalExpr
35− Delete :: String -> RelationalExpr -- needs restriction support
36− Update :: String -> M.Map String Atom -> RelationalExpr -- needs restriction support
37−
38−{- maybe break this into multiple steps:
39−1. check relational types for match (attribute counts) (typechecking step
40−2. create an execution plan (another system of nodes, another GADT)
41−3. execute the plan
42−-}
43− deriving (Show)
44−
45−type RelVarState a = State RelVarContext a
46−
47−--helper function to process relation variable creation/assignment
48−setRelVar :: String -> Relation -> RelVarState (Either RelationalError Relation)
49−setRelVar relVarName rel = do
50− relVars <- get
51− put $ M.insert relVarName rel relVars
52− return $ Right rel
53−
54−eval :: RelationalExpr -> RelVarState (Either RelationalError Relation)
55−
56−--define a relvar by creating an empty-tupled relation
57−eval (Define relVarName attributes) = do
58− relvars <- get
59− case M.member relVarName relvars of
60− True -> return (Left (RelvarAlreadyDefined relVarName))
61− False -> setRelVar relVarName emptyRelation
62− where
63− emptyRelation = Relation attributes HS.empty
64−
65−eval (Assign relVarName expr) = do
66− relVarTable <- get
67− -- in the future, it would be nice to get types from the RelationalExpr instead of needing to evaluate it
68− let existingRelVar = M.lookup relVarName relVarTable
69− value <- eval expr
70− case value of
71− Left err -> return $ Left err
72− Right rel -> case existingRelVar of
73− Nothing -> setRelVar relVarName rel
74− Just existingRel -> if attributes existingRel == attributes rel then
75− setRelVar relVarName rel
76− else
77− return $ Left RelvarAssignmentTypeMismatch
78−
79−
80−eval (RelationVariable name) = do
81− relvarTable <- get
11+--relvar state is needed in evaluation of relational expression but only as read-only in order to extract current relvar values
12+evalRelationalExpr :: RelationalExpr -> DatabaseState (Either RelationalError Relation)
13+evalRelationalExpr (RelationVariable name) = do
14+ relvarTable <- liftM relationVariables get
8215 return $ case M.lookup name relvarTable of
8316 Just res -> Right res
84− Nothing -> Left $ RelvarNotDefinedError name
17+ Nothing -> Left $ RelVarNotDefinedError name
8518
86−eval (Project attrNameSet expr) = do
87− rel <- eval expr
19+evalRelationalExpr (Project attrNameSet expr) = do
20+ rel <- evalRelationalExpr expr
8821 case rel of
8922 Right rel -> return $ project attrNameSet rel
9023 Left err -> return $ Left err
9124
92−eval (Union exprA exprB) = do
93− relA <- eval exprA
94− relB <- eval exprB
25+evalRelationalExpr (Union exprA exprB) = do
26+ relA <- evalRelationalExpr exprA
27+ relB <- evalRelationalExpr exprB
9528 case relA of
9629 Left err -> return $ Left err
9730 Right relA -> case relB of
9831 Left err -> return $ Left err
9932 Right relB -> return $ union relA relB
10033
101−eval (Join exprA exprB) = do
102− relA <- eval exprA
103− relB <- eval exprB
34+evalRelationalExpr (Join exprA exprB) = do
35+ relA <- evalRelationalExpr exprA
36+ relB <- evalRelationalExpr exprB
10437 case relA of
10538 Left err -> return $ Left err
10639 Right relA -> case relB of
10740 Left err -> return $ Left err
10841 Right relB -> return $ join relA relB
10942
110−eval (MultipleExpr exprs) = do
111− evald <- mapM eval exprs
112− return $ last evald
113−
114−eval (MakeStaticRelation attributes tupleSet) = do
43+evalRelationalExpr (MakeStaticRelation attributes tupleSet) = do
11544 case mkRelation attributes tupleSet of
11645 Right rel -> return $ Right rel
11746 Left err -> return $ Left err
11847
119−eval (Rename oldAttrName newAttrName relExpr) = do
120− evald <- eval relExpr
48+evalRelationalExpr (Rename oldAttrName newAttrName relExpr) = do
49+ evald <- evalRelationalExpr relExpr
12150 case evald of
12251 Right rel -> return $ rename oldAttrName newAttrName rel
12352 Left err -> return $ Left err
12453
125−eval (Group oldAttrNameSet newAttrName relExpr) = do
126− evald <- eval relExpr
54+evalRelationalExpr (Group oldAttrNameSet newAttrName relExpr) = do
55+ evald <- evalRelationalExpr relExpr
12756 case evald of
12857 Right rel -> return $ group oldAttrNameSet newAttrName rel
12958 Left err -> return $ Left err
13059
131−eval (Ungroup attrName relExpr) = do
132− evald <- eval relExpr
60+evalRelationalExpr (Ungroup attrName relExpr) = do
61+ evald <- evalRelationalExpr relExpr
13362 case evald of
13463 Right rel -> return $ ungroup attrName rel
13564 Left err -> return $ Left err
136−
137−eval (Insert relVarName relExpr) = do
138− evald <- eval $ Assign relVarName (Union relExpr (RelationVariable relVarName))
139− case evald of
140− Right rel -> return $ evald
141− Left err -> return $ Left err
142−
143−emptyRelVarContext :: RelVarContext
144−emptyRelVarContext = M.empty
145−
146−basicRelVarContext :: RelVarContext
147−basicRelVarContext = M.fromList [("true", relationTrue),
148− ("false", relationFalse)]
149−
150−dateExamples :: RelVarContext
151−dateExamples = M.union basicRelVarContext dateRelVars
65+
66+emptyDatabaseContext :: DatabaseContext
67+emptyDatabaseContext = DatabaseContext { inclusionDependencies = HS.empty,
68+ relationVariables = M.empty}
69+
70+basicDatabaseContext :: DatabaseContext
71+basicDatabaseContext = DatabaseContext { inclusionDependencies = HS.empty,
72+ relationVariables = M.fromList [("true", relationTrue),
73+ ("false", relationFalse)]}
74+
75+dateExamples :: DatabaseContext
76+dateExamples = DatabaseContext { inclusionDependencies = HS.empty, -- add foreign key relationships
77+ relationVariables = M.union (relationVariables basicDatabaseContext) dateRelVars }
15278 where
15379 dateRelVars = M.fromList [("S", suppliers),
15480 ("P", products),
@@ -212,3 +138,57 @@ supplierProductsRel = case mkRelation attributes tupleSet of
212138 M.fromList [("S#", StringAtom "S4"), ("P#", StringAtom "P4"), ("QTY", IntAtom 300)],
213139 M.fromList [("S#", StringAtom "S4"), ("P#", StringAtom "P5"), ("QTY", IntAtom 400)]
214140 ]
141+
142+--helper function to process relation variable creation/assignment
143+setRelVar :: String -> Relation -> DatabaseState (Maybe RelationalError)
144+setRelVar relVarName rel = do
145+ state <- get
146+ let newRelVars = M.insert relVarName rel $ relationVariables state
147+ put $ DatabaseContext (inclusionDependencies state) newRelVars
148+ return Nothing
149+
150+evalContextExpr :: DatabaseExpr -> DatabaseState (Maybe RelationalError)
151+evalContextExpr (Define relVarName attrs) = do
152+ relvars <- liftM relationVariables get
153+ case M.member relVarName relvars of
154+ True -> return (Just (RelVarAlreadyDefinedError relVarName))
155+ False -> setRelVar relVarName emptyRelation
156+ where
157+ emptyRelation = Relation attrs HS.empty
158+
159+evalContextExpr (Assign relVarName expr) = do
160+ -- in the future, it would be nice to get types from the RelationalExpr instead of needing to evaluate it
161+ relVarTable <- liftM relationVariables get
162+ let existingRelVar = M.lookup relVarName relVarTable
163+ value <- evalRelationalExpr expr
164+ case value of
165+ Left err -> return $ Just err
166+ Right rel -> case existingRelVar of
167+ Nothing -> setRelVar relVarName rel
168+ Just existingRel -> if attributes existingRel == attributes rel then
169+ setRelVar relVarName rel
170+ else
171+ return $ Just RelVarAssignmentTypeMismatchError
172+
173+evalContextExpr (Insert relVarName relExpr) = evalContextExpr $ Assign relVarName (Union relExpr (RelationVariable relVarName))
174+
175+--assign empty rel until restriction is implemented
176+evalContextExpr (Delete relVarName) = do
177+ relVarTable <- liftM relationVariables get
178+ case M.lookup relVarName relVarTable of
179+ Nothing -> return $ Just (RelVarNotDefinedError relVarName)
180+ Just rel -> setRelVar relVarName (Relation (attributes rel) emptyTupleSet)
181+
182+evalContextExpr (Update relVarName attrAssignments) = undefined
183+
184+evalContextExpr (AddInclusionDependency dep) = undefined
185+
186+evalContextExpr (MultipleExpr exprs) = do
187+ evald <- mapM evalContextExpr exprs
188+ return $ last evald
189+
190+-- restrict relvar to get affected tuples, update tuples, delete restriction from relvar, relvar = relvar union updated tuples
191+--evalRelVarExpr (Update relVarName updateMap) = do
192+
193+
194+