From fea6e347bd3a99b66437d771f1cfd76477b63bc2 Mon Sep 17 00:00:00 2001 From: Jake Wheat Date: Sat, 19 Apr 2014 11:18:29 +0300 Subject: [PATCH] change joins so natural is represented by separate field to on/using some fixes and tweaks to the reserved keyword handling, especially in the typename parser --- Language/SQL/SimpleSQL/Parser.lhs | 53 +++++++++++++------ Language/SQL/SimpleSQL/Pretty.lhs | 13 ++--- Language/SQL/SimpleSQL/Syntax.lhs | 5 +- .../Language/SQL/SimpleSQL/ErrorMessages.lhs | 12 ++--- tools/Language/SQL/SimpleSQL/GroupBy.lhs | 5 +- tools/Language/SQL/SimpleSQL/Postgres.lhs | 4 +- tools/Language/SQL/SimpleSQL/TableRefs.lhs | 32 +++++------ 7 files changed, 73 insertions(+), 51 deletions(-) diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs index bc09552..07efc92 100644 --- a/Language/SQL/SimpleSQL/Parser.lhs +++ b/Language/SQL/SimpleSQL/Parser.lhs @@ -551,13 +551,11 @@ TODO: this need heavy refactoring > -- precision, scale, lob scale and units, timezone, character > -- set and collations > otherTypeName = do -> tn <- (try multiWordParsers <|> names <|> baseTypeName) +> tn <- (try multiWordParsers <|> names) > choice [try $ timezone tn > ,try (precscale tn) >>= optionSuffix charSuffix > ,try $ lob tn > ,optionSuffix charSuffix $ TypeName tn] -> -- fix this hack, needs left factoring better or something -> baseTypeName = (:[]) . Name <$> identifier > timezone tn = do > TimeTypeName tn > <$> optionMaybe prec @@ -625,6 +623,30 @@ TODO: this need heavy refactoring > ,"nchar varying" > ,"bit varying" > ,"binary large object" +> -- put all the typenames which are also reserved keywords here +> ,"array" +> ,"bigint" +> ,"binary" +> ,"blob" +> ,"boolean" +> ,"char" +> ,"character" +> ,"clob" +> ,"date" +> ,"dec" +> ,"decimal" +> ,"double" +> ,"float" +> ,"int" +> ,"integer" +> ,"nchar" +> ,"nclob" +> ,"numeric" +> ,"real" +> ,"smallint" +> ,"time" +> ,"timestamp" +> ,"varchar" > ] > intervalQualifier :: Parser (IntervalTypeField,Maybe IntervalTypeField) @@ -644,7 +666,7 @@ use a data type for the datetime field? > datetimeField :: Parser String > datetimeField = choice (map keyword ["year","month","day" -> ,"hour","minute","second"]) +> ,"hour","minute","second"]) > "datetime field" == value expression parens, row ctor and scalar subquery @@ -880,11 +902,11 @@ tref > ,return $ TRSimple n]] > >>= optionSuffix aliasSuffix > aliasSuffix j = option j (TRAlias j <$> alias) -> joinTrefSuffix t = (do -> nat <- option False (True <$ keyword_ "natural") -> TRJoin t <$> joinType +> joinTrefSuffix t = +> (TRJoin t <$> option False (True <$ keyword_ "natural") +> <*> joinType > <*> nonJoinTref -> <*> optionMaybe (joinCondition nat)) +> <*> optionMaybe joinCondition) > >>= optionSuffix joinTrefSuffix TODO: factor the join stuff to produce better error messages @@ -904,10 +926,9 @@ TODO: factor the join stuff to produce better error messages > <* keyword_ "join" > ,JInner <$ keyword_ "join"] -> joinCondition :: Bool -> Parser JoinCondition -> joinCondition nat = -> choice [guard nat >> return JoinNatural -> ,keyword_ "on" >> JoinOn <$> valueExpr +> joinCondition :: Parser JoinCondition +> joinCondition = +> choice [keyword_ "on" >> JoinOn <$> valueExpr > ,keyword_ "using" >> JoinUsing <$> parens (commaSep1 name) > ] @@ -1296,8 +1317,8 @@ The standard has a weird mix of reserved keywords and unreserved keywords (I'm not sure what exactly being an unreserved keyword means). -> nonReservedWord :: [String] -> nonReservedWord = +> _nonReservedWord :: [String] +> _nonReservedWord = > ["a" > ,"abs" > ,"absolute" @@ -1605,11 +1626,11 @@ means). > ,"current_user" > ,"cursor" > ,"cycle" -> --,"date" +> ,"date" > --,"day" > ,"deallocate" > ,"dec" -> --,"decimal" +> ,"decimal" > ,"declare" > --,"default" > ,"delete" diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 48002ab..2dea1c5 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/Language/SQL/SimpleSQL/Pretty.lhs @@ -366,15 +366,13 @@ which have been changed to try to improve the layout of the output. > tr (TRAlias t a) = sep [tr t, alias a] > tr (TRParens t) = parens $ tr t > tr (TRQueryExpr q) = parens $ queryExpr q -> tr (TRJoin t0 jt t1 jc) = +> tr (TRJoin t0 b jt t1 jc) = > sep [tr t0 -> ,joinText jt jc <+> tr t1 +> ,if b then text "natural" else empty +> ,joinText jt <+> tr t1 > ,joinCond jc] -> joinText jt jc = -> sep [case jc of -> Just JoinNatural -> text "natural" -> _ -> empty -> ,case jt of +> joinText jt = +> sep [case jt of > JInner -> text "inner" > JLeft -> text "left" > JRight -> text "right" @@ -385,7 +383,6 @@ which have been changed to try to improve the layout of the output. > joinCond (Just (JoinUsing es)) = > text "using" <+> parens (commaSep $ map name es) > joinCond Nothing = empty -> joinCond (Just JoinNatural) = empty > maybeValueExpr :: String -> Maybe ValueExpr -> Doc > maybeValueExpr k = me diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index e2aeef1..dc85c17 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/Language/SQL/SimpleSQL/Syntax.lhs @@ -340,8 +340,8 @@ I'm not sure if this is valid syntax or not. > -- | Represents a entry in the csv of tables in the from clause. > data TableRef = -- | from t / from s.t > TRSimple [Name] -> -- | from a join b -> | TRJoin TableRef JoinType TableRef (Maybe JoinCondition) +> -- | from a join b, the bool is true if natural was used +> | TRJoin TableRef Bool JoinType TableRef (Maybe JoinCondition) > -- | from (a) > | TRParens TableRef > -- | from a as b(c,d) @@ -367,5 +367,4 @@ I'm not sure if this is valid syntax or not. > -- | The join condition. > data JoinCondition = JoinOn ValueExpr -- ^ on expr > | JoinUsing [Name] -- ^ using (column list) -> | JoinNatural -- ^ natural join was used > deriving (Eq,Show,Read,Data,Typeable) diff --git a/tools/Language/SQL/SimpleSQL/ErrorMessages.lhs b/tools/Language/SQL/SimpleSQL/ErrorMessages.lhs index 1f6c71c..5345373 100644 --- a/tools/Language/SQL/SimpleSQL/ErrorMessages.lhs +++ b/tools/Language/SQL/SimpleSQL/ErrorMessages.lhs @@ -72,12 +72,12 @@ expression parts. > ,"'bad" > ,"bad'" -> ,"interval '5' ays" -> ,"interval '5' days (4.4)" -> ,"interval '5' days (a)" -> ,"intervala '5' days" -> ,"interval 'x' days (3" -> ,"interval 'x' days 3)" +> ,"interval '5' ay" +> ,"interval '5' day (4.4)" +> ,"interval '5' day (a)" +> ,"intervala '5' day" +> ,"interval 'x' day (3" +> ,"interval 'x' day 3)" > ,"1badiden" > ,"$" diff --git a/tools/Language/SQL/SimpleSQL/GroupBy.lhs b/tools/Language/SQL/SimpleSQL/GroupBy.lhs index 9f76878..a824bec 100644 --- a/tools/Language/SQL/SimpleSQL/GroupBy.lhs +++ b/tools/Language/SQL/SimpleSQL/GroupBy.lhs @@ -221,11 +221,14 @@ sure which sql version they were introduced, 1999 or 2003 I think). > \ORDER BY GROUP, WEEK, DAY_WEEK, MONTH, REGION"-} > -- as group - needs more subtle keyword blacklisting +> -- decimal as a function not allowed due to the reserved keyword +> -- handling: todo, review if this is ansi standard function or +> -- if there are places where reserved keywords can still be used > ,"SELECT MONTH(SALES_DATE) AS MONTH,\n\ > \REGION,\n\ > \SUM(SALES) AS UNITS_SOLD,\n\ > \MAX(SALES) AS BEST_SALE,\n\ -> \CAST(ROUND(AVG(DECIMAL(SALES)),2) AS DECIMAL(5,2)) AS AVG_UNITS_SOLD\n\ +> \CAST(ROUND(AVG(DECIMALx(SALES)),2) AS DECIMAL(5,2)) AS AVG_UNITS_SOLD\n\ > \FROM SALES\n\ > \GROUP BY CUBE(MONTH(SALES_DATE),REGION)\n\ > \ORDER BY MONTH, REGION" diff --git a/tools/Language/SQL/SimpleSQL/Postgres.lhs b/tools/Language/SQL/SimpleSQL/Postgres.lhs index ce1f500..cf506d3 100644 --- a/tools/Language/SQL/SimpleSQL/Postgres.lhs +++ b/tools/Language/SQL/SimpleSQL/Postgres.lhs @@ -104,6 +104,8 @@ queries section > ,"SELECT x FROM test1 GROUP BY x;" > ,"SELECT x, sum(y) FROM test1 GROUP BY x;" +> -- s.date changed to s.datex because of reserved keyword +> -- handling, not sure if this is correct or not for ansi sql > ,"SELECT product_id, p.name, (sum(s.units) * p.price) AS sales\n\ > \ FROM products p LEFT JOIN sales s USING (product_id)\n\ > \ GROUP BY product_id, p.name, p.price;" @@ -112,7 +114,7 @@ queries section > ,"SELECT x, sum(y) FROM test1 GROUP BY x HAVING x < 'c';" > ,"SELECT product_id, p.name, (sum(s.units) * (p.price - p.cost)) AS profit\n\ > \ FROM products p LEFT JOIN sales s USING (product_id)\n\ -> \ WHERE s.date > CURRENT_DATE - INTERVAL '4 weeks'\n\ +> \ WHERE s.datex > CURRENT_DATE - INTERVAL '4 weeks'\n\ > \ GROUP BY product_id, p.name, p.price, p.cost\n\ > \ HAVING sum(p.price * s.units) > 5000;" diff --git a/tools/Language/SQL/SimpleSQL/TableRefs.lhs b/tools/Language/SQL/SimpleSQL/TableRefs.lhs index 91bd35d..ed59345 100644 --- a/tools/Language/SQL/SimpleSQL/TableRefs.lhs +++ b/tools/Language/SQL/SimpleSQL/TableRefs.lhs @@ -35,47 +35,47 @@ these lateral queries make no sense but the syntax is valid > ,ms [TRSimple "a", TRLateral $ TRSimple "b"]) > ,("select a from a natural join lateral b" -> ,ms [TRJoin (TRSimple "a") JInner +> ,ms [TRJoin (TRSimple "a") True JInner > (TRLateral $ TRSimple "b") -> (Just JoinNatural)]) +> Nothing]) > -- the lateral binds on the outside of the join which is incorrect > ,("select a from lateral a natural join lateral b" -> ,ms [TRJoin (TRLateral $ TRSimple "a") JInner +> ,ms [TRJoin (TRLateral $ TRSimple "a") True JInner > (TRLateral $ TRSimple "b") -> (Just JoinNatural)]) +> Nothing]) > ,("select a from t inner join u on expr" -> ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u") +> ,ms [TRJoin (TRSimple "t") False JInner (TRSimple "u") > (Just $ JoinOn $ Iden "expr")]) > ,("select a from t join u on expr" -> ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u") +> ,ms [TRJoin (TRSimple "t") False JInner (TRSimple "u") > (Just $ JoinOn $ Iden "expr")]) > ,("select a from t left join u on expr" -> ,ms [TRJoin (TRSimple "t") JLeft (TRSimple "u") +> ,ms [TRJoin (TRSimple "t") False JLeft (TRSimple "u") > (Just $ JoinOn $ Iden "expr")]) > ,("select a from t right join u on expr" -> ,ms [TRJoin (TRSimple "t") JRight (TRSimple "u") +> ,ms [TRJoin (TRSimple "t") False JRight (TRSimple "u") > (Just $ JoinOn $ Iden "expr")]) > ,("select a from t full join u on expr" -> ,ms [TRJoin (TRSimple "t") JFull (TRSimple "u") +> ,ms [TRJoin (TRSimple "t") False JFull (TRSimple "u") > (Just $ JoinOn $ Iden "expr")]) > ,("select a from t cross join u" -> ,ms [TRJoin (TRSimple "t") +> ,ms [TRJoin (TRSimple "t") False > JCross (TRSimple "u") Nothing]) > ,("select a from t natural inner join u" -> ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u") -> (Just JoinNatural)]) +> ,ms [TRJoin (TRSimple "t") True JInner (TRSimple "u") +> Nothing]) > ,("select a from t inner join u using(a,b)" -> ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u") +> ,ms [TRJoin (TRSimple "t") False JInner (TRSimple "u") > (Just $ JoinUsing ["a", "b"])]) > ,("select a from (select a from t)" @@ -92,15 +92,15 @@ these lateral queries make no sense but the syntax is valid > ,("select a from (t cross join u) as u" > ,ms [TRAlias (TRParens $ -> TRJoin (TRSimple "t") JCross (TRSimple "u") Nothing) +> TRJoin (TRSimple "t") False JCross (TRSimple "u") Nothing) > (Alias "u" Nothing)]) > -- todo: not sure if the associativity is correct > ,("select a from t cross join u cross join v", > ms [TRJoin -> (TRJoin (TRSimple "t") +> (TRJoin (TRSimple "t") False > JCross (TRSimple "u") Nothing) -> JCross (TRSimple "v") Nothing]) +> False JCross (TRSimple "v") Nothing]) > ] > where > ms f = makeSelect {qeSelectList = [(Iden "a",Nothing)]