From 65610af74e574c7fc585a8a2f159092e8a9117de Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Sat, 14 Dec 2013 13:05:02 +0200
Subject: [PATCH] refactor app parser, from parser

---
 Language/SQL/SimpleSQL/Parser.lhs | 124 ++++++++++++++----------------
 Tests.lhs                         |   8 ++
 2 files changed, 66 insertions(+), 66 deletions(-)

diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index a4fc568..1dcf12c 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -125,18 +125,16 @@ The parsing for the aggregate extensions is here as well:
 aggregate([all|distinct] args [order by orderitems])
 
 > aggOrApp :: P ScalarExpr
-> aggOrApp = do
->       i <- identifierString
->       _ <- symbol "("
->       d <- try duplicates
->       es <- choice [(:[]) <$> try star
->                    ,commaSep scalarExpr']
->       od <- try $ optionMaybe orderBy
->       _ <- symbol ")"
->       case (d,od) of
->           (Nothing,Nothing) ->
->               return $ App i es
->           _ -> return $ AggregateApp i d es (fromMaybe [] od)
+> aggOrApp =
+>     makeApp
+>     <$> identifierString
+>     <*> parens ((,,) <$> try duplicates
+>                      <*> choice [(:[]) <$> try star
+>                                 ,commaSep scalarExpr']
+>                      <*> try (optionMaybe orderBy))
+>   where
+>     makeApp i (Nothing,es,Nothing) = App i es
+>     makeApp i (d,es,od) = AggregateApp i d es (fromMaybe [] od)
 
 > duplicates :: P (Maybe Duplicates)
 > duplicates = optionMaybe $ try $
@@ -161,8 +159,7 @@ always used with the optionSuffix combinator.
 >                <*> option [] orderBy)
 >   where
 >     partitionBy = try (keyword_ "partition") >>
->         keyword_ "by" >>
->         commaSep1 scalarExpr'
+>         keyword_ "by" >> commaSep1 scalarExpr'
 > windowSuffix _ = fail ""
 
 > app :: P ScalarExpr
@@ -351,7 +348,7 @@ The parsers:
 >     PrefixOp <$> opSymbol <*> scalarExpr'
 >   where
 >     opSymbol = choice (map (try . symbol) prefixUnOpSymbolNames
->                       ++ map (try . keyword) prefixUnOpKeywordNames)
+>                        ++ map (try . keyword) prefixUnOpKeywordNames)
 
 > postfixOpSuffix :: ScalarExpr -> P ScalarExpr
 > postfixOpSuffix e =
@@ -473,60 +470,48 @@ optional or use try itself. The caller could do this.
 
 == from
 
-this parser should be refactored, it is very unclear. Here is the
-rough grammar
+Here is the rough grammar for joins
 
 tref
-(cross | [natural]
-         ([inner]
-          | left [outer]
-          | right [outer]
-          | full [outer]
-         )
-join tref
+(cross | [natural] ([inner] | (left | right | full) [outer])) join
+tref
 [on expr | using (...)]
 
-
 > from :: P [TableRef]
 > from = try (keyword_ "from") *> commaSep1 tref
 >   where
->     tref = choice [try (JoinQueryExpr <$> parens queryExpr)
->                   ,JoinParens <$> parens tref
->                   ,SimpleTableRef <$> identifierString]
->            >>= optionSuffix pjoin
->            >>= optionSuffix alias
->     pjoin tref0 =
->         choice
->         [try (keyword_ "natural") *> keyword_ "inner"
->          *> conditionlessSuffix tref0 Inner (Just JoinNatural)
->         ,try (keyword_ "join")
->          *> (JoinTableRef Inner tref0 <$> tref <*> joinExpr)
->         ,try (keyword_ "inner")
->          *> conditionSuffix tref0 Inner
->         ,try (choice [JLeft <$ keyword_ "left"
->                      ,JRight <$ keyword_ "right"
->                      ,Full <$ keyword_ "full"])
->          >>= outerJoinSuffix tref0
->         ,try (keyword_ "cross")
->          *> conditionlessSuffix tref0 Cross Nothing
->         ]
->         >>= optionSuffix pjoin
->     outerJoinSuffix tref0 jt =
->         optional (keyword_ "outer") *> conditionSuffix tref0 jt
->     conditionSuffix tref0 jt =
->         keyword_ "join" *> (JoinTableRef jt tref0 <$> tref <*> joinExpr)
->     conditionlessSuffix tref0 jt jc =
->         keyword_ "join" *> (JoinTableRef jt tref0 <$> tref <*> return jc)
->     joinExpr = choice
->                [(Just . JoinUsing)
->                  <$> (try (keyword_ "using")
->                       *> parens (commaSep1 identifierString))
->                ,(Just . JoinOn) <$> (try (keyword_ "on") *> scalarExpr)
->                ,return Nothing
+>     tref = nonJoinTref >>= optionSuffix joinTrefSuffix
+>     nonJoinTref = choice [try (JoinQueryExpr <$> parens queryExpr)
+>                          ,JoinParens <$> parens tref
+>                          ,SimpleTableRef <$> identifierString]
+>                   >>= optionSuffix aliasSuffix
+>     aliasSuffix j =
+>         let tableAlias = optional (try $ keyword_ "as") *> identifierString
+>             columnAliases = optionMaybe $ try $ parens
+>                             $ commaSep1 identifierString
+>         in option j (JoinAlias j <$> try tableAlias <*> try columnAliases)
+>     joinTrefSuffix t = (do
+>          nat <- option False $ try (True <$ (try $ keyword_ "natural"))
+>          JoinTableRef <$> joinType
+>                       <*> return t
+>                       <*> nonJoinTref
+>                       <*> optionMaybe (joinCondition nat))
+>         >>= optionSuffix joinTrefSuffix
+>     joinType = choice
+>                [Cross <$ try (keyword_ "cross")
+>                ,Inner <$ try (keyword_ "inner")
+>                ,choice [JLeft <$ try (keyword_ "left")
+>                        ,JRight <$ try (keyword_ "right")
+>                        ,Full <$ try (keyword_ "full")]
+>                 <* optional (try $ keyword_ "outer")]
+>                <* keyword "join"
+>     joinCondition nat =
+>         choice [guard nat >> return JoinNatural
+>                ,try (keyword_ "on") >>
+>                 JoinOn <$> scalarExpr
+>                ,try (keyword_ "using") >>
+>                 JoinUsing <$> parens (commaSep1 identifierString)
 >                ]
->     alias j = let a1 = optional (try (keyword_ "as")) *> identifierString
->                   a2 = optionMaybe (try $ parens (commaSep1 identifierString))
->               in option j (JoinAlias j <$> try a1 <*> try a2)
 
 == simple other parts
 
@@ -666,11 +651,13 @@ blacklist of keywords which aren't supported as identifiers.
 >     letterDigitOrUnderscore = char '_' <|> alphaNum
 
 > blacklist :: [String]
-> blacklist = ["as", "from", "where", "having", "group", "order"
->             ,"inner", "left", "right", "full", "natural", "join"
->             ,"on", "using", "when", "then", "case", "end", "order"
->             ,"limit", "offset", "in"
->             ,"except", "intersect", "union"]
+> blacklist =
+>     ["select", "as", "from", "where", "having", "group", "order"
+>     ,"limit", "offset"
+>     ,"inner", "left", "right", "full", "natural", "join"
+>     ,"cross", "on", "using"
+>     ,"when", "then", "case", "end", "in"
+>     ,"except", "intersect", "union"]
 
 TODO: talk about what must be in the blacklist, and what doesn't need
 to be.
@@ -738,6 +725,11 @@ whitespace parser which skips comments also
 
 = generic parser helpers
 
+a possible issue with the option suffix is that it enforces left
+associativity when chaining it recursively. Have to review
+all these uses and figure out if any should be right associative
+instead, and create an alternative suffix parser
+
 > optionSuffix :: (a -> P a) -> a -> P a
 > optionSuffix p a = option a (p a)
 
diff --git a/Tests.lhs b/Tests.lhs
index 1acc2b9..ec612b9 100644
--- a/Tests.lhs
+++ b/Tests.lhs
@@ -299,6 +299,14 @@
 >     ,("select a from (t cross join u) as u"
 >      ,ms [JoinAlias (JoinParens $ JoinTableRef Cross (SimpleTableRef "t")
 >                             (SimpleTableRef "u") Nothing) "u" Nothing])
+>      -- todo: not sure if the associativity is correct
+>     ,("select a from t cross join u cross join v",
+>        ms [JoinTableRef Cross
+>            (JoinTableRef Cross (SimpleTableRef "t")
+>                                (SimpleTableRef "u")
+>                                Nothing)
+>            (SimpleTableRef "v")
+>            Nothing])
 >     ]
 >   where
 >     ms f = makeSelect {qeSelectList = [(Nothing,Iden "a")]