refactor app parser, from parser

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
+> aggOrApp =
->       i <- identifierString
+>     makeApp
->       _ <- symbol "("
+>     <$> identifierString
->       d <- try duplicates
+>     <*> parens ((,,) <$> try duplicates
->       es <- choice [(:[]) <$> try star
+>                      <*> choice [(:[]) <$> try star
->                    ,commaSep scalarExpr']
+>                                 ,commaSep scalarExpr']
->       od <- try $ optionMaybe orderBy
+>                      <*> try (optionMaybe orderBy))
->       _ <- symbol ")"
+>   where
->       case (d,od) of
+>     makeApp i (Nothing,es,Nothing) = App i es
->           (Nothing,Nothing) ->
+>     makeApp i (d,es,od) = AggregateApp i d es (fromMaybe [] od)
->               return $ App i es
->           _ -> return $ 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" >>
+>         keyword_ "by" >> commaSep1 scalarExpr'
->         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
+Here is the rough grammar for joins
-rough grammar
 
 tref
-(cross | [natural]
+(cross | [natural] ([inner] | (left | right | full) [outer])) join
-         ([inner]
+tref
-          | left [outer]
-          | right [outer]
-          | full [outer]
-         )
-join tref
 [on expr | using (...)]
 
-
 > from :: P [TableRef]
 > from = try (keyword_ "from") *> commaSep1 tref
 >   where
->     tref = choice [try (JoinQueryExpr <$> parens queryExpr)
+>     tref = nonJoinTref >>= optionSuffix joinTrefSuffix
->                   ,JoinParens <$> parens tref
+>     nonJoinTref = choice [try (JoinQueryExpr <$> parens queryExpr)
->                   ,SimpleTableRef <$> identifierString]
+>                          ,JoinParens <$> parens tref
->            >>= optionSuffix pjoin
+>                          ,SimpleTableRef <$> identifierString]
->            >>= optionSuffix alias
+>                   >>= optionSuffix aliasSuffix
->     pjoin tref0 =
+>     aliasSuffix j =
->         choice
+>         let tableAlias = optional (try $ keyword_ "as") *> identifierString
->         [try (keyword_ "natural") *> keyword_ "inner"
+>             columnAliases = optionMaybe $ try $ parens
->          *> conditionlessSuffix tref0 Inner (Just JoinNatural)
+>                             $ commaSep1 identifierString
->         ,try (keyword_ "join")
+>         in option j (JoinAlias j <$> try tableAlias <*> try columnAliases)
->          *> (JoinTableRef Inner tref0 <$> tref <*> joinExpr)
+>     joinTrefSuffix t = (do
->         ,try (keyword_ "inner")
+>          nat <- option False $ try (True <$ (try $ keyword_ "natural"))
->          *> conditionSuffix tref0 Inner
+>          JoinTableRef <$> joinType
->         ,try (choice [JLeft <$ keyword_ "left"
+>                       <*> return t
->                      ,JRight <$ keyword_ "right"
+>                       <*> nonJoinTref
->                      ,Full <$ keyword_ "full"])
+>                       <*> optionMaybe (joinCondition nat))
->          >>= outerJoinSuffix tref0
+>         >>= optionSuffix joinTrefSuffix
->         ,try (keyword_ "cross")
+>     joinType = choice
->          *> conditionlessSuffix tref0 Cross Nothing
+>                [Cross <$ try (keyword_ "cross")
->         ]
+>                ,Inner <$ try (keyword_ "inner")
->         >>= optionSuffix pjoin
+>                ,choice [JLeft <$ try (keyword_ "left")
->     outerJoinSuffix tref0 jt =
+>                        ,JRight <$ try (keyword_ "right")
->         optional (keyword_ "outer") *> conditionSuffix tref0 jt
+>                        ,Full <$ try (keyword_ "full")]
->     conditionSuffix tref0 jt =
+>                 <* optional (try $ keyword_ "outer")]
->         keyword_ "join" *> (JoinTableRef jt tref0 <$> tref <*> joinExpr)
+>                <* keyword "join"
->     conditionlessSuffix tref0 jt jc =
+>     joinCondition nat =
->         keyword_ "join" *> (JoinTableRef jt tref0 <$> tref <*> return jc)
+>         choice [guard nat >> return JoinNatural
->     joinExpr = choice
+>                ,try (keyword_ "on") >>
->                [(Just . JoinUsing)
+>                 JoinOn <$> scalarExpr
->                  <$> (try (keyword_ "using")
+>                ,try (keyword_ "using") >>
->                       *> parens (commaSep1 identifierString))
+>                 JoinUsing <$> parens (commaSep1 identifierString)
->                ,(Just . JoinOn) <$> (try (keyword_ "on") *> scalarExpr)
->                ,return Nothing
 >                ]
->     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"
+> blacklist =
->             ,"inner", "left", "right", "full", "natural", "join"
+>     ["select", "as", "from", "where", "having", "group", "order"
->             ,"on", "using", "when", "then", "case", "end", "order"
+>     ,"limit", "offset"
->             ,"limit", "offset", "in"
+>     ,"inner", "left", "right", "full", "natural", "join"
->             ,"except", "intersect", "union"]
+>     ,"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)
 

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