fix/work around issues with the keywords parsing
fix the infix and postfix keywords parsing minor refactoring
This commit is contained in:
Jake Wheat
parent
b0f1e044b4
commit
438e3383e4
|
|
@ -119,7 +119,7 @@ which parses as a typed literal
|
|||
> mkIt <$> stringToken
|
||||
> <*> optionMaybe
|
||||
> ((,) <$> identifierBlacklist blacklist
|
||||
> <*> optionMaybe (parens integer))
|
||||
> <*> optionMaybe (parens unsignedInteger))
|
||||
> where
|
||||
> mkIt val Nothing = TypedLit (TypeName "interval") val
|
||||
> mkIt val (Just (a,b)) = IntervalLit val a b
|
||||
|
|
@ -541,7 +541,7 @@ todo: timestamp types:
|
|||
| TIMESTAMParser [ <left paren> <timestamp precision> <right paren> ] [ WITH TIME ZONE ]
|
||||
|
||||
|
||||
> precision t = parens (commaSep integer) >>= makeWrap t
|
||||
> precision t = parens (commaSep unsignedInteger) >>= makeWrap t
|
||||
> makeWrap (TypeName t) [a] = return $ PrecTypeName t a
|
||||
> makeWrap (TypeName t) [a,b] = return $ PrecScaleTypeName t a b
|
||||
> makeWrap _ _ = fail "there must be one or two precision components"
|
||||
|
|
@ -574,8 +574,8 @@ There is probably a simpler way of doing this but I am a bit
|
|||
thick.
|
||||
|
||||
> makeKeywordTree :: [String] -> Parser [String]
|
||||
> makeKeywordTree sets = do
|
||||
> reverse <$> parseTrees (sort $ map words sets)
|
||||
> makeKeywordTree sets =
|
||||
> parseTrees (sort $ map words sets)
|
||||
> -- ?? <?> intercalate "," sets
|
||||
> where
|
||||
> parseTrees :: [[String]] -> Parser [String]
|
||||
|
|
@ -584,14 +584,14 @@ thick.
|
|||
> gs = groupBy ((==) `on` head) ws
|
||||
> choice $ map parseGroup gs
|
||||
> parseGroup :: [[String]] -> Parser [String]
|
||||
> parseGroup l = do
|
||||
> let k = head $ head l
|
||||
> parseGroup l@((k:_):_) = do
|
||||
> keyword_ k
|
||||
> let tls = map tail l
|
||||
> pr = (k:) <$> parseTrees tls
|
||||
> if (or $ map null tls)
|
||||
> then pr <|> return [k]
|
||||
> else pr
|
||||
> parseGroup _ = guard False >> error "impossible"
|
||||
|
||||
== operator parsing
|
||||
|
||||
|
|
@ -673,12 +673,12 @@ messages, but both of these are considered too important.
|
|||
> binaryKeyword nm assoc = binary (keyword_ nm) nm assoc
|
||||
> binaryKeywords p =
|
||||
> E.Infix (do
|
||||
> o <- p
|
||||
> o <- try p
|
||||
> return (\a b -> BinOp a [Name $ unwords o] b))
|
||||
> E.AssocNone
|
||||
> postfixKeywords p =
|
||||
> postfix' $ do
|
||||
> o <- p
|
||||
> o <- try p
|
||||
> return $ PostfixOp [Name $ unwords o]
|
||||
> binary p nm assoc =
|
||||
> E.Infix (p >> return (\a b -> BinOp a [Name nm] b)) assoc
|
||||
|
|
@ -979,8 +979,8 @@ whitespace parser which skips comments also
|
|||
> lexeme :: Parser a -> Parser a
|
||||
> lexeme p = p <* whitespace
|
||||
|
||||
> integer :: Parser Integer
|
||||
> integer = read <$> lexeme (many1 digit) <?> "integer"
|
||||
> unsignedInteger :: Parser Integer
|
||||
> unsignedInteger = read <$> lexeme (many1 digit) <?> "integer"
|
||||
|
||||
|
||||
number literals
|
||||
|
|
|
|||
|
|
@ -40,15 +40,13 @@ which have been changed to try to improve the layout of the output.
|
|||
> valueExpr (IntervalLit v u p) =
|
||||
> text "interval" <+> quotes (text v)
|
||||
> <+> text u
|
||||
> <+> maybe empty (parens . text . show ) p
|
||||
> <+> me (parens . text . show ) p
|
||||
> valueExpr (Iden i) = names i
|
||||
> valueExpr Star = text "*"
|
||||
> valueExpr Parameter = text "?"
|
||||
> valueExpr (HostParameter p i) =
|
||||
> text (':':p)
|
||||
> <+> maybe empty
|
||||
> (\i' -> text "indicator" <+> text (':':i'))
|
||||
> i
|
||||
> <+> me (\i' -> text "indicator" <+> text (':':i')) i
|
||||
|
||||
> valueExpr (App f es) = names f <> parens (commaSep (map valueExpr es))
|
||||
|
||||
|
|
@ -69,7 +67,7 @@ which have been changed to try to improve the layout of the output.
|
|||
> _ -> text "partition by"
|
||||
> <+> nest 13 (commaSep $ map valueExpr pb))
|
||||
> <+> orderBy od
|
||||
> <+> maybe empty frd fr)
|
||||
> <+> me frd fr)
|
||||
> where
|
||||
> frd (FrameFrom rs fp) = rsd rs <+> fpd fp
|
||||
> frd (FrameBetween rs fps fpe) =
|
||||
|
|
@ -120,7 +118,7 @@ which have been changed to try to improve the layout of the output.
|
|||
> valueExpr e0 <+> names f <+> valueExpr e1
|
||||
|
||||
> valueExpr (Case t ws els) =
|
||||
> sep $ [text "case" <+> maybe empty valueExpr t]
|
||||
> sep $ [text "case" <+> me valueExpr t]
|
||||
> ++ map w ws
|
||||
> ++ maybeToList (fmap e els)
|
||||
> ++ [text "end"]
|
||||
|
|
@ -231,9 +229,9 @@ which have been changed to try to improve the layout of the output.
|
|||
> ,grpBy gb
|
||||
> ,maybeValueExpr "having" hv
|
||||
> ,orderBy od
|
||||
> ,maybe empty (\e -> text "offset" <+> valueExpr e <+> text "rows") off
|
||||
> ,maybe empty (\e -> text "fetch first" <+> valueExpr e
|
||||
> <+> text "rows only") fe
|
||||
> ,me (\e -> text "offset" <+> valueExpr e <+> text "rows") off
|
||||
> ,me (\e -> text "fetch first" <+> valueExpr e
|
||||
> <+> text "rows only") fe
|
||||
> ]
|
||||
> queryExpr (CombineQueryExpr q1 ct d c q2) =
|
||||
> sep [queryExpr q1
|
||||
|
|
@ -264,12 +262,12 @@ which have been changed to try to improve the layout of the output.
|
|||
> alias :: Alias -> Doc
|
||||
> alias (Alias nm cols) =
|
||||
> text "as" <+> name nm
|
||||
> <+> maybe empty (parens . commaSep . map name) cols
|
||||
> <+> me (parens . commaSep . map name) cols
|
||||
|
||||
> selectList :: [(ValueExpr,Maybe Name)] -> Doc
|
||||
> selectList is = commaSep $ map si is
|
||||
> where
|
||||
> si (e,al) = valueExpr e <+> maybe empty als al
|
||||
> si (e,al) = valueExpr e <+> me als al
|
||||
> als al = text "as" <+> name al
|
||||
|
||||
> from :: [TableRef] -> Doc
|
||||
|
|
@ -307,7 +305,7 @@ which have been changed to try to improve the layout of the output.
|
|||
> joinCond (Just JoinNatural) = empty
|
||||
|
||||
> maybeValueExpr :: String -> Maybe ValueExpr -> Doc
|
||||
> maybeValueExpr k = maybe empty
|
||||
> maybeValueExpr k = me
|
||||
> (\e -> sep [text k
|
||||
> ,nest (length k + 1) $ valueExpr e])
|
||||
|
||||
|
|
@ -342,3 +340,6 @@ which have been changed to try to improve the layout of the output.
|
|||
|
||||
> commaSep :: [Doc] -> Doc
|
||||
> commaSep ds = sep $ punctuate comma ds
|
||||
|
||||
> me :: (a -> Doc) -> Maybe a -> Doc
|
||||
> me = maybe empty
|
||||
|
|
|
|||
|
|
@ -127,12 +127,12 @@
|
|||
> -- Maybe String is for the
|
||||
> -- indicator, e.g. :var
|
||||
> -- indicator :nl
|
||||
> | QuantifiedComparison
|
||||
> | QuantifiedComparison
|
||||
> ValueExpr
|
||||
> [Name] -- operator
|
||||
> CompPredQuantifier
|
||||
> QueryExpr
|
||||
> | Match ValueExpr Bool -- true if unique
|
||||
> | Match ValueExpr Bool -- true if unique
|
||||
> QueryExpr
|
||||
> | Array ValueExpr [ValueExpr] -- ^ represents an array
|
||||
> -- access expression, or an array ctor
|
||||
|
|
@ -157,7 +157,6 @@
|
|||
> | PrecScaleTypeName String Integer Integer
|
||||
> deriving (Eq,Show,Read,Data,Typeable)
|
||||
|
||||
|
||||
> -- | Used for 'expr in (value expression list)', and 'expr in
|
||||
> -- (subquery)' syntax.
|
||||
> data InPredValue = InList [ValueExpr]
|
||||
|
|
|
|||
Loading…
Reference in a new issue