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