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

@@ -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)
@@ -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"

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

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)

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"
 >     ,"$"

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"

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;"
 

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)]