--- This module parses a list of Token according to --- the supported SQL grammar. It internally makes use of the SQL Parser Monad --- defined in the SQLParserTypes module. --- The result is an abstract syntax tree or - in case of errors - --- the list of error messages wrapped in the ParseMonad (PM) which is --- part of curryPP. --- An error recovery approach is realized. ---@author Julia Krone ---@version 0.1 -- ---------------------------------------------------------------------------- module SQLParser(parseTkLs) where import ParseTypes import SQLAst import SQLToken import SQLParserTypes --- Organizes the wrapping with respect to the internally used Parser Monad. --- Invokes the parsing process for each single statement. --- Returns a list of statements (as AST) wrapped in a ParseMonad. parseTkLs :: Pos -> [Token] -> PM [Statement] parseTkLs pos tks = let (SPM _ pm tk) = parseStatement (newEmptySPM pos tks) in if tk == [] then liftPM (\st -> [st]) pm else combinePMs (:) pm (parseTkLs pos tk) -- selects which kind of SQL-Statement to parse parseStatement :: SPMParser Statement parseStatement espm | hasToken espm = case headToken espm of KW_Select -> (parseSelect .<~. (terminalOrConsume Semi)) (continue espm) KW_Insert -> (parseInsert .<~. (terminalOrConsume Semi)) (continue espm) KW_Delete -> (parseDelete .<~. (terminalOrConsume Semi)) (continue espm) KW_Update -> bindDefSPM parseTableName (Table "" "" 0) (\t -> (((terminalOrProc KW_Set [KW_Where, Semi]) .~>.(parseUpdate t)) .<~.(terminalOrConsume Semi))) [KW_Set] (continue espm) In -> (parseTransaction .<~. (terminalOrConsume Semi)) (continue espm) KW_Begin -> ((terminalOrConsume Semi) .~>. (initializeSPM Transaction)) (continue espm) KW_Commit -> ((terminalOrConsume Semi) .~>. (initializeSPM Commit)) (continue espm) KW_Rollback -> ((terminalOrConsume Semi) .~>. (initializeSPM Rollback)) (continue espm) _ -> parseError ("There is no valid keyword at the " ++"beginning of SQL-Statement") (proceedAfter Semi espm) |otherwise = emptyTkErr espm -- --------------------transaction statement ------------------------------- -- Parser for Transaction Statement. The In Transaction Statement is a special -- functionality of CDBI, which executes the given List of Statement (just -- returning the last result) and automatically executes a rollback in case of -- an error and a commit otherwise parseTransaction :: SPMParser Statement parseTransaction espm = ((terminalOrProc KW_Transaction [Semi]) .~>. (liftSPM (\sts -> InTransaction sts) (combineSPMs (:) ((terminalOrProc LParen [Semi]) .~>.parseStatement) parseStatements))) espm -- Combines several statements to a list. parseStatements :: SPMParser [Statement] parseStatements espm | hasToken espm = case headToken espm of RParen -> initializeSPM [] (continue espm) _ -> combineSPMs (:) parseStatement parseStatements espm | otherwise = emptyTkErr espm -- --------------------parsing functions for select statement --------------- -- Parser for Select-Statement, which consists of -- SelectHead, Order-By-Clause and Limit parseSelect :: SPMParser Statement parseSelect espm = combineSPMs (\selhead (order, lim) -> Select selhead order lim) parseSelectHead parseOrderNLimit espm -- Parser for Order-By-Clause and Limit-Clause of Select-Statement parseOrderNLimit :: SPMParser (Order, Maybe Int) parseOrderNLimit espm = combineSPMs (\order lim -> (order, lim)) parseOrderBy parseLimit espm -- Parser for SelectHead of Select-Statement, which can be followed -- by another SelectHead connected by a setoperator -- Jumps to next symbol in follow-set in case of error using -- a default selectHead for binding. parseSelectHead :: SPMParser SelectHead parseSelectHead espm = bindDefSPM parseQuery defSelHead parseSetOrSimple follow espm where follow = setOps++[KW_Order, KW_Limit] defSelHead = Query (SelAll AAll) (TableRef (Table "" "" 0) Nothing) NoCond Nothing -- checks if SelectHead is followed by another one and if so -- invokes corresponding parser parseSetOrSimple :: SelectHead -> SPMParser SelectHead parseSetOrSimple selhead espm | hasToken espm = case headToken espm of (SetOp _ ) -> combineSPMs (\op head2 -> Set op selhead head2) parseSetOp ((terminalOrProc KW_Select [KW_Order, KW_Limit]) .~>. parseSelectHead) espm _ -> initializeSPM selhead espm | otherwise = emptyTkErr espm -- Parser for setoperator -- in case of failure jumps to next Select-keyword or Semicolon parseSetOp :: SPMParser ASetOp parseSetOp espm | hasToken espm = case headToken espm of (SetOp Union) -> initializeSPM AUnion (continue espm) (SetOp Intersect) -> initializeSPM AIntersect (continue espm) (SetOp Except) -> initializeSPM AExcept (continue espm) _ -> parseError ("Expected set-operator but got "++ (tokentoString $ headToken espm)) (proceedWithOneOf [KW_Select, Semi] espm) | otherwise = emptyTkErr espm -- Parser for combining all parts of SelectHead parseQuery :: SPMParser SelectHead parseQuery espm = combineSPMs (\ sel (tabs, cond, group) -> Query sel tabs cond group) parseSelectClause parseFromCondGroup espm -- Parser to combine parts of Selectclause i.e. all or distinct and elementlist parseSelectClause :: SPMParser SelectClause parseSelectClause espm = bindSPM parseSpecifier parseSelElements [KW_From] espm -- Parser for All or Distinct, All is taken as default parseSpecifier :: SPMParser ASpecifier parseSpecifier espm | hasToken espm = case headToken espm of KW_Distinct -> initializeSPM ADistinct (continue espm) KW_All -> initializeSPM AAll (continue espm) _ -> initializeSPM AAll espm | otherwise = emptyTkErr espm -- Parser for Selectclause parseSelElements :: ASpecifier -> SPMParser SelectClause parseSelElements spec espm | hasToken espm = case headToken espm of Asterix -> initializeSPM (SelAll spec) (continue espm) _ -> liftSPM (\elems -> SelColumns spec elems) (combineSPMs (:) parseElem parseElemList) espm | otherwise = emptyTkErr espm -- Parser for List of Elements(Columns, Case-Expression, -- Aggregation) which to Select -- Jumps to From-Clause (follow-set) in case of error parseElemList :: SPMParser [SelElement] parseElemList espm | hasToken espm = case headToken espm of KW_From -> initializeSPM [] espm Comma -> combineSPMs (:) parseElem parseElemList (continue espm) _ -> parseError ("Expected ',' or 'From', but got: "++ (tokentoString $ headToken espm)) (proceedWith KW_From espm) | otherwise = emptyTkErr espm -- Parser for single Select-element parseElem :: SPMParser SelElement parseElem espm | hasToken espm = case headToken espm of KW_Case -> ((terminalOrProc KW_When [Comma, KW_From]) .~>. (combineSPMs (\cond (val1, val2) -> Case cond val1 val2) parseConstraint (parseValueTuple .<~. (terminal KW_End)))) (continue espm) (Fun _) -> parseAggregation espm _ -> liftSPM (\col -> Col col) parseColumn espm | otherwise = emptyTkErr espm -- Parser for the two values given in a case-expression parseValueTuple :: SPMParser (Operand, Operand) parseValueTuple espm = combineSPMs (\val1 val2 -> (val1, val2)) ((terminalOrProc KW_Then [KW_Else]) .~>. parseOperand) ((terminalOrProc KW_Else [KW_End, KW_From]) .~>. parseOperand) espm -- Parser for aggrgation function name -- Jumps to next symbol in follow-set or '(' in case of error parseFun :: SPMParser AFun parseFun espm = case headToken espm of (Fun Sum) -> initializeSPM ASum (continue espm) (Fun Avg) -> initializeSPM AAvg (continue espm) (Fun Count) -> initializeSPM ACount (continue espm) (Fun Min) -> initializeSPM AMin (continue espm) (Fun Max) -> initializeSPM AMax (continue espm) _ -> parseError ("Not supported aggregationfunction" ++ "given") (proceedWithOneOf [LParen, Comma, KW_From] espm) -- Parser to combine whole aggregation expression parseAggregation :: SPMParser SelElement parseAggregation espm = combineSPMs (\fun (spec, col) -> Aggregation fun spec col) parseFun (((terminalOrProc LParen [Comma, KW_From]) .~>. (combineSPMs (,) parseSpecifier parseColumn)) .<~. (terminal RParen)) espm -- Parser to combine rear parts of SelectHead, i.e. -- FromClause, WhereClause and Group-By-Clause parseFromCondGroup :: SPMParser (TableRef, Condition, Maybe Group) parseFromCondGroup espm = combineSPMs (\tabs (cond, group) -> (tabs, cond, group)) ((terminalOrProc KW_From follow) .~>. parseTableRef) parseCondGroup espm where follow = setOps++[KW_Where, KW_Group, KW_Order, KW_Limit] -- Parser to combine parts of a TableReference parseTableRef :: SPMParser TableRef parseTableRef espm = combineSPMs (\tab join -> TableRef tab join) parseTabNPseudo parseMaybeJoin espm -- Combines TableName with Pseudonym if there is one -- Jumps to next symbol in follow-set in case of error. parseTabNPseudo :: SPMParser Table parseTabNPseudo espm = bindDefSPM parseIdentifier "" parsePseudonym follow espm where follow = [KW_As, KW_Cross, KW_Inner, Comma, KW_Where, KW_On, KW_Group, KW_Order, KW_Limit]++setOps -- Creates TableNode with Pseudonym (if there is one) -- otherwise uses default alias "table" -- Default CDBI-alias 0 will be resolved by Namer. parsePseudonym :: String -> SPMParser Table parsePseudonym tab espm | hasToken espm = case headToken espm of KW_As -> (parsePseudoString tab) (continue espm) _ -> initializeSPM (Table tab "table" 0) espm | otherwise = emptyTkErr espm -- Parser for String representing the table-pseudonym. -- Creates Tablenode with name, alias CDBI-alias. -- Default CDBI-alias 0 will be resolved by Namer. -- Jumps to next symbol in follow-set in case of error. parsePseudoString :: String -> SPMParser Table parsePseudoString tab espm | hasToken espm = case headToken espm of (Ident pseudo) -> initializeSPM (Table tab pseudo 0) (continue espm) KW_Table -> parseError ("Table is a reserved keyword "++ "and not allowed as alias.") (proceedWithOneOf follow espm) _ -> parseError ("No valid alias found after 'AS'.") (proceedWithOneOf follow espm) | otherwise = emptyTkErr espm where follow = [Comma, KW_Where, KW_Group, KW_Order, KW_Limit]++setOps -- Checks if there is a Join and in case there is, invokes the right -- parsing procedure, if not initializes with Nothing parseMaybeJoin :: SPMParser (Maybe JoinClause) parseMaybeJoin espm | hasToken espm = case headToken espm of KW_Cross -> ((terminalOrProc KW_Join follow) .~>. (combineSPMs (\tab join -> Just (CrossJoin tab join)) parseTabNPseudo parseMaybeJoin)) (continue espm) KW_Inner -> ((terminalOrProc KW_Join follow) .~>. combineSPMs (\(tab, cond) join -> Just (InnerJoin tab cond join)) (combineSPMs (\tab cond -> (tab, cond)) parseTabNPseudo parseJoinCond) parseMaybeJoin) (continue espm) Comma -> (combineSPMs (\tab join -> Just (CrossJoin tab join)) parseTabNPseudo parseMaybeJoin) (continue espm) _ -> initializeSPM Nothing espm | otherwise = emptyTkErr espm where follow = [Comma, KW_Where, KW_Group, KW_Order, KW_Limit]++setOps -- Parser for JoinCondition (for inner joins) -- Jumps to next symbol in follow-set in case of error. parseJoinCond :: SPMParser JoinCond parseJoinCond espm | hasToken espm = case headToken espm of KW_On -> liftSPM (\cond -> JC cond) (bindSPM parseConstraint parseConstraints follow) (continue espm) _ -> parseError ("Missing condition for inner join") (proceedWithOneOf follow espm) | otherwise = emptyTkErr espm where follow = [KW_Cross, KW_Inner, Comma, KW_Where, KW_Group, KW_Order, KW_Limit]++setOps -- Combines Condition (Where-Clause) and Group-By-Clause of Select-Statement parseCondGroup:: SPMParser (Condition, Maybe Group) parseCondGroup espm = combineSPMs (\cond group -> (cond, group)) parseSelWhereClause parseGroup espm -- Checks if there is a Where-Clause and if there is, invokes -- the corresponding parsing procedure -- Jumps to next symbol in follow-set in case of error. parseSelWhereClause :: SPMParser Condition parseSelWhereClause espm | hasToken espm = case headToken espm of KW_Group -> initializeSPM NoCond espm (SetOp _) -> initializeSPM NoCond espm KW_Order -> initializeSPM NoCond espm Semi -> initializeSPM NoCond espm KW_Limit -> initializeSPM NoCond espm RParen -> initializeSPM NoCond espm KW_Where -> bindDefSPM parseConstraint NoCond parseConstraints followConstr (continue espm) _ -> parseError ("Error while parsing before: "++ (tokentoString $ headToken espm)) (proceedWithOneOf followWhere espm) | otherwise = emptyTkErr espm where followWhere = [KW_Group, KW_Order, KW_Limit]++setOps followConstr = [ RParen, KW_Then, KW_Cross, KW_Inner, KW_Group, KW_Order, KW_Limit]++logOps++setOps --Parser for Group-By-Clause. Initializes with Nothing if there is non. parseGroup :: SPMParser (Maybe Group) parseGroup espm | hasToken espm = case headToken espm of KW_Group -> ((terminalOrProc KW_By [KW_Order, KW_Limit]) .~>. (combineSPMs (\ cols have -> Just (GroupBy cols have)) (combineSPMs (:) parseColumn parseColumnList) parseHaving)) (continue espm) _ -> initializeSPM Nothing espm | otherwise = emptyTkErr espm -- Parser for list of Columns in Group-By-Clause. -- Jumps to next symbol in follow-set in case of error. parseColumnList :: SPMParser [ColumnRef] parseColumnList espm | hasToken espm = case headToken espm of Semi -> initializeSPM [] espm KW_Having -> initializeSPM [] espm RParen -> initializeSPM [] espm KW_Order -> initializeSPM [] espm Comma -> combineSPMs (:) parseColumn parseColumnList (continue espm) _ -> parseError ("Expected list of columns for group by " ++ "statement") (proceedWithOneOf ([KW_Having, KW_Order, KW_Limit] ++setOps) espm) | otherwise = emptyTkErr espm -- Combines parts of Having-Clause -- Jumps to next symbol in follow-set in case of error. parseHaving :: SPMParser Having parseHaving espm | hasToken espm = case headToken espm of KW_Having -> bindDefSPM parseHaveCond NoHave parseCompHaveCond follow (continue espm) _ -> initializeSPM NoHave espm | otherwise = emptyTkErr espm where follow = [RParen, KW_Order, KW_Limit]++setOps++logOps -- Parser for Condition in Having-Clause. -- Treated seperatly to make sure that aggregation is not -- used in Where-Clauses. -- Jumps to next symbol in follow-set in case of error. parseHaveCond :: SPMParser Having parseHaveCond espm | hasToken espm = case headToken espm of LParen -> ((bindDefSPM parseHaveCond NoHave parseCompHaveCond follow) .<~. (terminal RParen)) (continue espm) KW_Not -> liftSPM (\cond -> Neg cond) (bindDefSPM parseHaveCond NoHave parseCompHaveCond follow) (continue espm) (Fun _) -> (combineSPMs (\fun (spec, col, op, operand) -> (AggrHave fun spec col op operand)) parseFun parseAggrHave) espm _ -> liftSPM (\cond -> SimpleHave cond) parseConstraint espm | otherwise = emptyTkErr espm where follow = [RParen, KW_Order, KW_Limit]++setOps++logOps -- Parser to combine compound having conditions -- Jumps to next symbol in follow-set in case of error. parseCompHaveCond :: Having -> SPMParser Having parseCompHaveCond have espm | hasToken espm = case headToken espm of (LogOp And) -> liftSPM (\have2 -> CmpHave AAnd have have2) (bindDefSPM parseHaveCond NoHave parseCompHaveCond follow) (continue espm) (LogOp Or) -> liftSPM (\have2 -> CmpHave AOr have have2) (bindDefSPM parseHaveCond NoHave parseCompHaveCond follow) (continue espm) _ -> initializeSPM have espm | otherwise = emptyTkErr espm where follow = logOps ++ setOps ++ [RParen, KW_Order, KW_Limit] --Combines all parts of aggregation inside having-clause parseAggrHave :: SPMParser (ASpecifier, ColumnRef, AstOp, Operand) parseAggrHave espm = combineSPMs (\spec (col, op, operand) -> (spec, col, op, operand)) ((terminalOrProc LParen follow) .~>. parseSpecifier) parseComparison espm where follow = logOps++binOps++setOps++[RParen, KW_Order, KW_Limit] -- Parser for comparison part inside the having-clause parseComparison :: SPMParser (ColumnRef, AstOp, Operand) parseComparison espm = combineSPMs (\col (op, operand) -> (col, op, operand)) (parseColumn .<~. (terminal RParen)) (combineSPMs (\op operand -> (op, operand)) parseBinOperator parseOperand) espm -- Parser for Order-By-Clause parseOrderBy :: SPMParser Order parseOrderBy espm | hasToken espm = case headToken espm of KW_Order -> ((terminalOrProc KW_By [KW_Limit]) .~>. (liftSPM (\cols -> OrderBy cols) (combineSPMs (:) parseOrderingTerm parseOrderingList))) (continue espm) _ -> initializeSPM (OrderBy []) espm | otherwise = emptyTkErr espm -- Parser for list of Columns and ordering directions -- Jumps to next limit or semicolon in case of error parseOrderingList :: SPMParser [(ColumnRef, Dir)] parseOrderingList espm | hasToken espm = case headToken espm of Comma -> combineSPMs (:) parseOrderingTerm parseOrderingList (continue espm) Semi -> initializeSPM [] espm KW_Limit -> initializeSPM [] espm RParen -> initializeSPM [] espm _ -> parseError ("Unexpected Token in Order-By-Clause, got: " ++ (tokentoString $ headToken espm)) (proceedWith KW_Limit espm) | otherwise = emptyTkErr espm -- Parser for single column-direction-Tuple parseOrderingTerm :: SPMParser (ColumnRef, Dir) parseOrderingTerm espm = combineSPMs (\ col dir -> (col, dir)) parseColumn parseDir espm -- Parser for direction, default is Ascending order parseDir :: SPMParser Dir parseDir espm | hasToken espm = case headToken espm of KW_Asc -> initializeSPM Asc (continue espm) KW_Desc -> initializeSPM Desc (continue espm) _ -> initializeSPM Asc espm | otherwise = emptyTkErr espm -- Parser for limit-clause parseLimit :: SPMParser (Maybe Int) parseLimit espm | hasToken espm = case headToken espm of KW_Limit -> liftSPM (\int -> Just int) parseIntegerExp (continue espm) _ -> initializeSPM Nothing espm | otherwise = emptyTkErr espm -- Parser for Integer expression in limit-clause -- jumps to next Semicolon in case of error parseIntegerExp :: SPMParser Int parseIntegerExp espm | hasToken espm = case headToken espm of (Constant (NumInt int)) -> initializeSPM int (continue espm) _ -> parseError "Expected Int to define limit." (proceedWith Semi espm) | otherwise = emptyTkErr espm -- ------------------------- parsing functions for Insert statement ---------- -- Combines tablename and insert specification for insert statement parseInsert :: SPMParser Statement parseInsert espm = bindDefSPM ((terminalOrProc KW_Into [LParen, KW_Values]) .~>. parseTableName) defTab parseInsertSpec [LParen, KW_Values] espm where defTab = (Table "" "" 0) parseInsertSpec :: Table -> SPMParser Statement parseInsertSpec table espm = combineSPMs (\columns valss -> Insert table columns valss) parseMaybeColumns ((terminalOrProc KW_Values [Semi]) .~>. parseValueClause) espm -- Checks whether there are just Values given or first a list of Columns -- and invokes corresponding parsing routine. -- Jumps to next Values-keyword or Semicolon in case of error. parseMaybeColumns :: SPMParser [ColumnRef] parseMaybeColumns espm | hasToken espm = case headToken espm of KW_Values -> initializeSPM [] espm LParen -> combineSPMs (:) parseColumn parseColumns (continue espm) _ -> parseError ("expected ValueClause starting with " ++"keyword 'Values' or a list of Columns") (proceedWith KW_Values espm) |otherwise = emptyTkErr espm -- Parser for simple List of columns in insert statement. -- Jumps to next Values-keyword or Semicolon in case of error. parseColumns :: SPMParser [ColumnRef] parseColumns espm | hasToken espm = case headToken espm of RParen -> initializeSPM [] (continue espm) Comma -> combineSPMs (:) parseColumn parseColumns (continue espm) _ -> parseError ("Expected List of Columns seperated by "++ "Comma and terminated by )") (proceedWith KW_Values espm) |otherwise = emptyTkErr espm -- Parser for Value-Clause of Insert statement parseValueClause :: SPMParser [[Value]] parseValueClause espm = combineSPMs (:) parseValsOrEmb parseValClTail espm -- Combines values to a list of lists of values. parseValClTail :: SPMParser [[Value]] parseValClTail espm | hasToken espm = case headToken espm of Semi -> initializeSPM [] espm Comma -> combineSPMs (:) parseValsOrEmb parseValClTail (continue espm) _ -> parseError ("Found " ++ (tokentoString $ headToken espm) ++" while parsing List of values.") (proceedWith Semi espm) | otherwise = emptyTkErr espm -- Distinguishes a single embedded expression from a list of values. -- Jumps to next Semicolon in case of error. parseValsOrEmb :: SPMParser [Value] parseValsOrEmb espm | hasToken espm = case headToken espm of (EmbedExp exp) -> initializeSPM [(Emb exp Unknown)] (continue espm) LParen -> parseValueList espm _ -> parseError ("Found " ++ (tokentoString $ headToken espm) ++" while parsing List of values.") (proceedWith Comma espm) | otherwise = emptyTkErr espm -- -------------------delete statement -------------------------------- -- Combines tablename with where-clause to obtain a Delete statement. parseDelete :: SPMParser Statement parseDelete espm = combineSPMs (\table cond -> (Delete table cond)) ((terminalOrProc KW_From [KW_Where, Semi]) .~>.parseTableName) parseWhereClause espm -- ---------------------- update statement --------------------------- -- Parser for Update statement. Checks whether a whole entity or single -- assignments are given and invokes corresponding parsing routine. -- Jumps to next semicolon in case of error. parseUpdate :: Table -> SPMParser Statement parseUpdate table espm | hasToken espm = case headToken espm of (Ident _) -> combineSPMs (\ assings cond -> (Update table assings cond)) parseAssignments parseWhereClause espm (EmbedExp exp) -> initializeSPM (UpdateEntity table (Emb exp Unknown)) (continue espm) _ -> parseError ("Expected assignements or an "++ "embedded expression in Update") (proceedWith Semi espm) |otherwise = emptyTkErr espm -- Parses list of column names and corresponding values for assignments, -- Jumps to next Where-Clause or Semicolon in case of error. parseAssignments :: SPMParser [Assign] parseAssignments espm | hasToken espm = case headToken espm of (Ident _) -> combineSPMs (:) parseAssignment parseAssignments espm Comma -> combineSPMs (:) parseAssignment parseAssignments (continue espm) KW_Where -> initializeSPM [] espm Semi -> initializeSPM [] espm _ -> parseError ("Error while parsing Assingments, found: " ++ (tokentoString $ headToken espm)) (proceedWith KW_Where espm) | otherwise = emptyTkErr espm -- Parser for a single assignment. --Jumps to next symbol in Follow-set in case of error. parseAssignment :: SPMParser Assign parseAssignment espm | hasToken espm = case headToken espm of (Ident name) -> ((terminalOrProc (BinOp Equal) [Comma, KW_Where]) .~>. (liftSPM (\val -> Assign (Column (Def ["table"]) name Unknown False 0) val) parseValue)) (continue espm) _ -> parseError "Expected name of a column for assignment." (proceedWithOneOf [Comma, KW_Where] espm) | otherwise = emptyTkErr espm -- -------------------common parts ----------------------------------- -- Parser for tablename (without pseudonym) -- using default "table" as alias and default CDBI-alias 0. --Jumps to next symbol in Follow-set in case of error. parseTableName :: SPMParser Table parseTableName espm | hasToken espm = case headToken espm of (Ident name) -> initializeSPM (Table name "table" 0) (continue espm) _ -> parseError ("Expected tablename, but got: " ++ (tokentoString $ headToken espm)) (proceedWithOneOf follow espm) | otherwise = emptyTkErr espm where follow = [KW_Where, LParen, KW_Set, KW_Values] --Parser for Where-Clause. --Jumps to next symbol in Follow-set in case of error. parseWhereClause :: SPMParser Condition parseWhereClause espm | hasToken espm = case headToken espm of Semi -> initializeSPM NoCond espm KW_Where -> bindDefSPM parseConstraint NoCond parseConstraints follow (continue espm) _ -> parseError ("Expected Start of Where-clause" ++ " or end of query, but got "++ (tokentoString $ headToken espm)) (proceedWithOneOf follow espm) |otherwise = emptyTkErr espm where follow = [RParen, KW_Then, KW_Cross, KW_Inner, KW_Group, KW_Order, KW_Limit, Semi]++logOps++setOps -- Parser for compound constraints. --Jumps to next symbol in Follow-set in case of error. parseConstraints :: Condition -> SPMParser Condition parseConstraints cond espm | hasToken espm = case headToken espm of (LogOp And) -> liftSPM (\cond2 -> Cmp AAnd cond cond2) (bindDefSPM parseConstraint NoCond parseConstraints follow) (continue espm) (LogOp Or) -> liftSPM (\cond2 -> Cmp AOr cond cond2) (bindDefSPM parseConstraint NoCond parseConstraints follow) (continue espm) _ -> initializeSPM cond espm | otherwise = emptyTkErr espm where follow = [ RParen, KW_Then, KW_Cross, KW_Inner, KW_Group, KW_Order, KW_Limit, Semi]++logOps++setOps -- Parser for a constraints. --Jumps to next symbol in Follow-set in case of error. parseConstraint :: SPMParser Condition parseConstraint espm | hasToken espm = case headToken espm of KW_Satisfies -> combineSPMs (\tab1 (rel, tab2) -> FK (tab1,0) (NotSpec rel) (tab2,0)) parseIdentifier (combineSPMs (\ rel tab -> (rel,tab)) parseIdentifier parseIdentifier) (continue espm) KW_Exists -> (((terminalOrProc LParen followC) .~>. parseSubquery) .<~. (terminal RParen)) (continue espm) KW_Not -> liftSPM (\cons -> Not cons) parseConstraint (continue espm) LParen -> ((bindDefSPM parseConstraint NoCond parseConstraints followC) .<~. (terminal RParen)) (continue espm) _ -> bindDefSPM parseOperand defVal parseOperator followO espm | otherwise = emptyTkErr espm where followC = [RParen, KW_Then, KW_Cross, KW_Inner, KW_Group, KW_Order, KW_Limit, Semi]++logOps++setOps defVal = (Right AbsNull) followO = [In, Is , KW_Not, Between]++binOps -- Parser for a subquery following the exists keyword. parseSubquery :: SPMParser Condition parseSubquery espm = (liftSPM (\query -> Exists query) ((terminalOrProc KW_Select follow) .~>. parseSelect) espm) where follow = [ RParen, KW_Then, KW_Cross, KW_Inner, KW_Group, KW_Order, KW_Limit, Semi]++logOps++setOps -- Parser for an operand. First checks whether operand -- is a column or a value and invokes the corresponding -- parser routine. parseOperand :: SPMParser Operand parseOperand espm | hasToken espm = case headToken espm of (Ident _ ) -> liftSPM (\col -> Left col) parseColumn espm _ -> liftSPM (\ val -> Right val) parseValue espm |otherwise = emptyTkErr espm -- Parser for all different kind of constant values. -- Jumps to next symbol in follow-set -- in case of an error. parseValue :: SPMParser Value parseValue espm | hasToken espm = case headToken espm of (EmbedExp exp) -> initializeSPM (Emb exp Unknown) (continue espm) (Constant (VarStr str)) -> initializeSPM (StringExp str) (continue espm) (Constant (NumInt int)) -> initializeSPM (IntExp int) (continue espm) (Constant (NumFloat float)) -> initializeSPM (FloatExp float) (continue espm) (Constant (Boolean bool)) -> initializeSPM (BoolExp bool) (continue espm) (Constant (Date date)) -> initializeSPM (DateExp date) (continue espm) (Constant (VarChar char)) -> initializeSPM (CharExp char) (continue espm) (Constant Null) -> initializeSPM AbsNull (continue espm) _ -> parseError ("No valid constant value " ++"found, but got: " ++ (tokentoString (headToken espm))) (proceedWithOneOf follow espm) | otherwise = emptyTkErr espm where follow = [RParen, Comma, KW_Then, KW_Else, KW_End, Is, In, Between, KW_Not, KW_Inner, KW_Cross, KW_Where, KW_Group, KW_Order, KW_Limit]++setOps++logOps++binOps -- Combines identifier to a column reference. --Jumps to next symbol in Follow-set in case of error. parseColumn :: SPMParser ColumnRef parseColumn espm = bindSPM parseIdentifier parseColumnRef follow espm where follow = [RParen, Comma, KW_Asc, KW_Desc, In, Is, KW_Not, Between, KW_Else, KW_End]++logOps++binOps -- Checks if the first identifier is the column name or a tablename. -- In case a tablename or alias is given it will be inserted in the -- ColumnRef-Node otherwise the default name "table" will bi inserted. parseColumnRef :: String -> SPMParser ColumnRef parseColumnRef ident espm | hasToken espm = case headToken espm of Stop -> liftSPM (\col -> Column (Unique ident) col Unknown False 0) parseIdentifier (continue espm) _ -> initializeSPM (Column (Def ["table"]) ident Unknown False 0) espm -- Parser for an identifier. parseIdentifier :: SPMParser String parseIdentifier espm | hasToken espm = case headToken espm of (Ident ident) -> initializeSPM ident (continue espm) _ -> parseError ("Expected identifier but got "++ (tokentoString $ headToken espm)) espm | otherwise = emptyTkErr espm -- Parser for the second part of a binary-operation. Selects which operator -- is applied, invokes corresponding parser routine and combines the results. parseOperator :: Operand -> SPMParser Condition parseOperator operand espm | hasToken espm = case headToken espm of Between -> combineSPMs (\op2 op3 -> ABetween operand op2 op3) parseOperand ((terminalOrProc (LogOp And) follow) .~>. parseOperand) (continue espm) Is -> ((terminalOrProc (Constant Null) follow) .~>. (initializeSPM (IsNull operand))) (continue espm) In -> liftSPM (\vals -> AIn operand vals) parseValueList (continue espm) KW_Not -> ((terminalOrProc (Constant Null) follow) .~>. (initializeSPM (NotNull operand))) (continue espm) _ -> combineSPMs (\op op2 -> ABinOp op operand op2 ) parseBinOperator parseOperand espm |otherwise = emptyTkErr espm where follow = [ RParen, KW_Then, KW_Cross, KW_Inner, KW_Group, KW_Order, KW_Limit, Semi]++logOps++setOps -- Parser for a list of values, used in the insert statement and with -- the "In"-operator. --Jumps to next symbol in Follow-set in case of error. parseValueList :: SPMParser [Value] parseValueList espm | hasToken espm = case headToken espm of LParen -> combineSPMs (:) parseValue parseValueList (continue espm) Comma -> combineSPMs (:) parseValue parseValueList (continue espm) RParen -> initializeSPM [] (continue espm) _ -> parseError ("Expected a list of values seperated " ++ "by comma and surrounded by parenthesis, got" ++ (tokentoString $ headToken espm)) (proceedWithOneOf follow espm) |otherwise = emptyTkErr espm where follow = [RParen, KW_Then, KW_Inner, KW_Cross, Comma, KW_Group, KW_Order, KW_Limit]++setOps --Parser for all simple kind of binary operator. --Jumps to next symbol in Follow-set in case of error. parseBinOperator :: SPMParser AstOp parseBinOperator espm | hasToken espm = case headToken espm of (BinOp Lth) -> initializeSPM ALth (continue espm) (BinOp Gth) -> initializeSPM AGth (continue espm) (BinOp Lte) -> initializeSPM ALe (continue espm) (BinOp Gte) -> initializeSPM AGe (continue espm) (BinOp Equal) -> initializeSPM AEq (continue espm) (BinOp Uneq) -> initializeSPM AUnEq (continue espm) (BinOp Like) -> initializeSPM ALike (continue espm) (Ident _) -> parseError ("No Valid BinaryOperator found," ++ " but got: " ++ (tokentoString $ headToken espm)) espm (Constant _) -> parseError ("No Valid BinaryOperator found," ++ " but got: " ++ (tokentoString $ headToken espm)) espm (EmbedExp _) -> parseError ("No Valid BinaryOperator found," ++ " but got: " ++ (tokentoString $ headToken espm)) espm _ -> parseError ("No Valid BinaryOperator found," ++ " but got: " ++ (tokentoString $ headToken espm)) (continue espm) |otherwise = emptyTkErr espm --auxiliary definitions to build up follow sets -------------------------- setOps :: [Token] setOps = [(SetOp Union), (SetOp Intersect), (SetOp Except)] logOps :: [Token] logOps = [(LogOp And), (LogOp Or)] binOps :: [Token] binOps = [(BinOp Lth), (BinOp Gth), (BinOp Lte), (BinOp Gte), (BinOp Equal), (BinOp Uneq), (BinOp Like)]