From 2c1eedb70f2fc47aaa3b2649e7c6a3bb42bbb4f0 Mon Sep 17 00:00:00 2001 From: Jake Wheat Date: Fri, 13 Dec 2013 17:00:22 +0200 Subject: [PATCH] implement complete base 10 number parser, shorten some syntax names --- Language/SQL/SimpleSQL/Parser.lhs | 58 +++++++++----- Language/SQL/SimpleSQL/Pretty.lhs | 8 +- Language/SQL/SimpleSQL/Syntax.lhs | 8 +- Tests.lhs | 126 ++++++++++++++++-------------- 4 files changed, 116 insertions(+), 84 deletions(-) diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs index 0fb8d5c..8255512 100644 --- a/Language/SQL/SimpleSQL/Parser.lhs +++ b/Language/SQL/SimpleSQL/Parser.lhs @@ -31,13 +31,35 @@ = scalar expressions > estring :: P ScalarExpr -> estring = StringLiteral <$> (symbol_ "'" *> manyTill anyChar (symbol_ "'")) +> estring = StringLit <$> (symbol_ "'" *> manyTill anyChar (symbol_ "'")) + +digits +digits.[digits][e[+-]digits] +[digits].digits[e[+-]digits] +digitse[+-]digits + +> number :: P ScalarExpr +> number = +> NumLit <$> (choice [int +> >>= optionSuffix dot +> >>= optionSuffix fracts +> >>= optionSuffix expon +> ,fract "" >>= optionSuffix expon] +> <* whiteSpace) +> where +> int = many1 digit +> fract p = dot p >>= fracts +> dot p = ((p++) . (:[])) <$> char '.' +> fracts p = (p++) <$> int +> expon p = do +> void $ char 'e' +> s <- option "" ((:[]) <$> (char '+' <|> char '-')) +> i <- int +> return (p ++ "e" ++ s ++ i) -> integer :: P ScalarExpr -> integer = NumLiteral <$> (many1 digit <* whiteSpace) > literal :: P ScalarExpr -> literal = integer <|> estring +> literal = number <|> estring > identifierString :: P String > identifierString = do @@ -57,10 +79,10 @@ TODO: talk about what must be in the blacklist, and what doesn't need to be. > identifier :: P ScalarExpr -> identifier = Identifier <$> identifierString +> identifier = Iden <$> identifierString -> dottedIdentifier :: P ScalarExpr -> dottedIdentifier = Identifier2 <$> identifierString +> dottedIden :: P ScalarExpr +> dottedIden = Iden2 <$> identifierString > <*> (symbol "." *> identifierString) > star :: P ScalarExpr @@ -104,7 +126,7 @@ to be. > ,scase > ,unaryOp > ,try app -> ,try dottedIdentifier +> ,try dottedIden > ,identifier > ,sparens] > trysuffix e = try (suffix e) <|> return e @@ -118,21 +140,21 @@ to be. > toHaskell :: ScalarExpr -> HSE.Exp > toHaskell e = case e of -> Identifier i -> HSE.Var $ HSE.UnQual $ HSE.Ident i -> StringLiteral l -> HSE.Lit $ HSE.String $ 's':l -> NumLiteral l -> HSE.Lit $ HSE.String $ 'n':l -> App n es -> HSE.App (toHaskell $ Identifier n) $ ltoh es +> Iden i -> HSE.Var $ HSE.UnQual $ HSE.Ident i +> StringLit l -> HSE.Lit $ HSE.String $ 's':l +> NumLit l -> HSE.Lit $ HSE.String $ 'n':l +> App n es -> HSE.App (toHaskell $ Iden n) $ ltoh es > Op n [e0,e1] -> HSE.InfixApp (toHaskell e0) > (HSE.QVarOp $ HSE.UnQual $ HSE.Ident n) > (toHaskell e1) > Op "not" [e0] -> toHaskell $ App "not" [e0] > Op {} -> error $ "bad args to operator " ++ groom e > Star -> HSE.Var $ HSE.UnQual $ HSE.Ident "*" -> Identifier2 a b -> HSE.Var $ HSE.Qual (HSE.ModuleName a) (HSE.Ident b) +> Iden2 a b -> HSE.Var $ HSE.Qual (HSE.ModuleName a) (HSE.Ident b) > Star2 q -> HSE.Var $ HSE.Qual (HSE.ModuleName q) (HSE.Ident "*") > Parens e0 -> HSE.Paren $ toHaskell e0 > -- map the two maybes to lists with either 0 or 1 element -> Case v ts el -> HSE.App (toHaskell $ Identifier "$case") +> Case v ts el -> HSE.App (toHaskell $ Iden "$case") > (HSE.List [ltoh $ maybeToList v > ,HSE.List $ map (ltoh . (\(a,b) -> [a,b])) ts > ,ltoh $ maybeToList el]) @@ -143,10 +165,10 @@ to be. > toSql e = case e of > HSE.Var (HSE.UnQual (HSE.Ident "*")) -> Star > HSE.Var (HSE.Qual (HSE.ModuleName q) (HSE.Ident "*")) -> Star2 q -> HSE.Var (HSE.Qual (HSE.ModuleName a) (HSE.Ident b)) -> Identifier2 a b -> HSE.Var (HSE.UnQual (HSE.Ident i)) -> Identifier i -> HSE.Lit (HSE.String ('s':l)) -> StringLiteral l -> HSE.Lit (HSE.String ('n':l)) -> NumLiteral l +> HSE.Var (HSE.Qual (HSE.ModuleName a) (HSE.Ident b)) -> Iden2 a b +> HSE.Var (HSE.UnQual (HSE.Ident i)) -> Iden i +> HSE.Lit (HSE.String ('s':l)) -> StringLit l +> HSE.Lit (HSE.String ('n':l)) -> NumLit l > HSE.App (HSE.Var (HSE.UnQual (HSE.Ident "$case"))) (HSE.List [v,ts,el]) -> > Case (ltom v) (pairs ts) (ltom el) > HSE.App (HSE.Var (HSE.UnQual (HSE.Ident "not"))) diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 9b6bfe4..f2d420a 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/Language/SQL/SimpleSQL/Pretty.lhs @@ -21,10 +21,10 @@ back into SQL source text. It attempts to format the output nicely. = scalar expressions > scalarExpr :: ScalarExpr -> Doc -> scalarExpr (StringLiteral s) = quotes $ text s -> scalarExpr (NumLiteral s) = text s -> scalarExpr (Identifier i) = text i -> scalarExpr (Identifier2 q i) = text q <> text "." <> text i +> scalarExpr (StringLit s) = quotes $ text s +> scalarExpr (NumLit s) = text s +> scalarExpr (Iden i) = text i +> scalarExpr (Iden2 q i) = text q <> text "." <> text i > scalarExpr Star = text "*" > scalarExpr (Star2 q) = text q <> text "." <> text "*" diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index 0a069a9..8203b5e 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/Language/SQL/SimpleSQL/Syntax.lhs @@ -9,10 +9,10 @@ > ) where -> data ScalarExpr = NumLiteral String -> | StringLiteral String -> | Identifier String -> | Identifier2 String String +> data ScalarExpr = NumLit String +> | StringLit String +> | Iden String +> | Iden2 String String > | Star > | Star2 String > | App String [ScalarExpr] diff --git a/Tests.lhs b/Tests.lhs index 17f864e..a4d06de 100644 --- a/Tests.lhs +++ b/Tests.lhs @@ -25,14 +25,24 @@ > literals :: TestItem > literals = Group "literals" $ map (uncurry TestScalarExpr) -> [("3", NumLiteral "3") -> ,("'string'", StringLiteral "string") +> [("3", NumLit "3") +> ,("3.", NumLit "3.") +> ,("3.3", NumLit "3.3") +> ,(".3", NumLit ".3") +> ,("3.e3", NumLit "3.e3") +> ,("3.3e3", NumLit "3.3e3") +> ,(".3e3", NumLit ".3e3") +> ,("3e3", NumLit "3e3") +> ,("3e+3", NumLit "3e+3") +> ,("3e-3", NumLit "3e-3") +> ,("'string'", StringLit "string") +> ,("'1'", StringLit "1") > ] > identifiers :: TestItem > identifiers = Group "identifiers" $ map (uncurry TestScalarExpr) -> [("iden1", Identifier "iden1") -> ,("t.a", Identifier2 "t" "a") +> [("iden1", Iden "iden1") +> ,("t.a", Iden2 "t" "a") > ] > star :: TestItem @@ -44,37 +54,37 @@ > app :: TestItem > app = Group "app" $ map (uncurry TestScalarExpr) > [("f()", App "f" []) -> ,("f(a)", App "f" [Identifier "a"]) -> ,("f(a,b)", App "f" [Identifier "a", Identifier "b"]) +> ,("f(a)", App "f" [Iden "a"]) +> ,("f(a,b)", App "f" [Iden "a", Iden "b"]) > ] > caseexp :: TestItem > caseexp = Group "caseexp" $ map (uncurry TestScalarExpr) > [("case a when 1 then 2 end" -> ,Case (Just $ Identifier "a") [(NumLiteral "1" -> ,NumLiteral "2")] Nothing) +> ,Case (Just $ Iden "a") [(NumLit "1" +> ,NumLit "2")] Nothing) > ,("case a when 1 then 2 when 3 then 4 end" -> ,Case (Just $ Identifier "a") [(NumLiteral "1", NumLiteral "2") -> ,(NumLiteral "3", NumLiteral "4")] Nothing) +> ,Case (Just $ Iden "a") [(NumLit "1", NumLit "2") +> ,(NumLit "3", NumLit "4")] Nothing) > ,("case a when 1 then 2 when 3 then 4 else 5 end" -> ,Case (Just $ Identifier "a") [(NumLiteral "1", NumLiteral "2") -> ,(NumLiteral "3", NumLiteral "4")] (Just $ NumLiteral "5")) +> ,Case (Just $ Iden "a") [(NumLit "1", NumLit "2") +> ,(NumLit "3", NumLit "4")] (Just $ NumLit "5")) > ,("case when a=1 then 2 when a=3 then 4 else 5 end" -> ,Case Nothing [(Op "=" [Identifier "a", NumLiteral "1"], NumLiteral "2") -> ,(Op "=" [Identifier "a",NumLiteral "3"], NumLiteral "4")] -> (Just $ NumLiteral "5")) +> ,Case Nothing [(Op "=" [Iden "a", NumLit "1"], NumLit "2") +> ,(Op "=" [Iden "a",NumLit "3"], NumLit "4")] +> (Just $ NumLit "5")) > ] > operators :: TestItem > operators = Group "operators" $ map (uncurry TestScalarExpr) -> [("a + b", Op "+" [Identifier "a", Identifier "b"]) -> ,("not not a", Op "not" [Op "not" [Identifier "a"]]) +> [("a + b", Op "+" [Iden "a", Iden "b"]) +> ,("not not a", Op "not" [Op "not" [Iden "a"]]) > ] > parens :: TestItem > parens = Group "parens" $ map (uncurry TestScalarExpr) -> [("(a)", Parens (Identifier "a")) -> ,("(a + b)", Parens (Op "+" [Identifier "a", Identifier "b"])) +> [("(a)", Parens (Iden "a")) +> ,("(a + b)", Parens (Op "+" [Iden "a", Iden "b"])) > ] > queryExprParserTests :: TestItem @@ -91,22 +101,22 @@ > selectLists :: TestItem > selectLists = Group "selectLists" $ map (uncurry TestQueryExpr) > [("select 1", -> makeSelect {qeSelectList = [(Nothing,NumLiteral "1")]}) +> makeSelect {qeSelectList = [(Nothing,NumLit "1")]}) > ,("select a" -> ,makeSelect {qeSelectList = [(Nothing,Identifier "a")]}) +> ,makeSelect {qeSelectList = [(Nothing,Iden "a")]}) > ,("select a,b" -> ,makeSelect {qeSelectList = [(Nothing,Identifier "a") -> ,(Nothing,Identifier "b")]}) +> ,makeSelect {qeSelectList = [(Nothing,Iden "a") +> ,(Nothing,Iden "b")]}) > ,("select 1+2,3+4" > ,makeSelect {qeSelectList = -> [(Nothing,Op "+" [NumLiteral "1",NumLiteral "2"]) -> ,(Nothing,Op "+" [NumLiteral "3",NumLiteral "4"])]}) +> [(Nothing,Op "+" [NumLit "1",NumLit "2"]) +> ,(Nothing,Op "+" [NumLit "3",NumLit "4"])]}) > ,("select a as a, /*comment*/ b as b" -> ,makeSelect {qeSelectList = [(Just "a", Identifier "a") -> ,(Just "b", Identifier "b")]}) +> ,makeSelect {qeSelectList = [(Just "a", Iden "a") +> ,(Just "b", Iden "b")]}) > ,("select a a, b b" -> ,makeSelect {qeSelectList = [(Just "a", Identifier "a") -> ,(Just "b", Identifier "b")]}) +> ,makeSelect {qeSelectList = [(Just "a", Iden "a") +> ,(Just "b", Iden "b")]}) > ] > from :: TestItem @@ -117,16 +127,16 @@ > ,ms [SimpleTableRef "t", SimpleTableRef "u"]) > ,("select a from t inner join u on expr" > ,ms [JoinTableRef Inner (SimpleTableRef "t") (SimpleTableRef "u") -> (Just $ JoinOn $ Identifier "expr")]) +> (Just $ JoinOn $ Iden "expr")]) > ,("select a from t left join u on expr" > ,ms [JoinTableRef JLeft (SimpleTableRef "t") (SimpleTableRef "u") -> (Just $ JoinOn $ Identifier "expr")]) +> (Just $ JoinOn $ Iden "expr")]) > ,("select a from t right join u on expr" > ,ms [JoinTableRef JRight (SimpleTableRef "t") (SimpleTableRef "u") -> (Just $ JoinOn $ Identifier "expr")]) +> (Just $ JoinOn $ Iden "expr")]) > ,("select a from t full join u on expr" > ,ms [JoinTableRef Full (SimpleTableRef "t") (SimpleTableRef "u") -> (Just $ JoinOn $ Identifier "expr")]) +> (Just $ JoinOn $ Iden "expr")]) > ,("select a from t cross join u" > ,ms [JoinTableRef Cross (SimpleTableRef "t") > (SimpleTableRef "u") Nothing]) @@ -147,54 +157,54 @@ > (SimpleTableRef "u") Nothing) "u"]) > ] > where -> ms f = makeSelect {qeSelectList = [(Nothing,Identifier "a")] +> ms f = makeSelect {qeSelectList = [(Nothing,Iden "a")] > ,qeFrom = f} > whereClause :: TestItem > whereClause = Group "whereClause" $ map (uncurry TestQueryExpr) > [("select a from t where a = 5" -> ,makeSelect {qeSelectList = [(Nothing,Identifier "a")] +> ,makeSelect {qeSelectList = [(Nothing,Iden "a")] > ,qeFrom = [SimpleTableRef "t"] -> ,qeWhere = Just $ Op "=" [Identifier "a", NumLiteral "5"]}) +> ,qeWhere = Just $ Op "=" [Iden "a", NumLit "5"]}) > ] > groupByClause :: TestItem > groupByClause = Group "groupByClause" $ map (uncurry TestQueryExpr) > [("select a,sum(b) from t group by a" -> ,makeSelect {qeSelectList = [(Nothing, Identifier "a") -> ,(Nothing, App "sum" [Identifier "b"])] +> ,makeSelect {qeSelectList = [(Nothing, Iden "a") +> ,(Nothing, App "sum" [Iden "b"])] > ,qeFrom = [SimpleTableRef "t"] -> ,qeGroupBy = [Identifier "a"] +> ,qeGroupBy = [Iden "a"] > }) > ,("select a,b,sum(c) from t group by a,b" -> ,makeSelect {qeSelectList = [(Nothing, Identifier "a") -> ,(Nothing, Identifier "b") -> ,(Nothing, App "sum" [Identifier "c"])] +> ,makeSelect {qeSelectList = [(Nothing, Iden "a") +> ,(Nothing, Iden "b") +> ,(Nothing, App "sum" [Iden "c"])] > ,qeFrom = [SimpleTableRef "t"] -> ,qeGroupBy = [Identifier "a",Identifier "b"] +> ,qeGroupBy = [Iden "a",Iden "b"] > }) > ] > having :: TestItem > having = Group "having" $ map (uncurry TestQueryExpr) > [("select a,sum(b) from t group by a having sum(b) > 5" -> ,makeSelect {qeSelectList = [(Nothing, Identifier "a") -> ,(Nothing, App "sum" [Identifier "b"])] +> ,makeSelect {qeSelectList = [(Nothing, Iden "a") +> ,(Nothing, App "sum" [Iden "b"])] > ,qeFrom = [SimpleTableRef "t"] -> ,qeGroupBy = [Identifier "a"] -> ,qeHaving = Just $ Op ">" [App "sum" [Identifier "b"], NumLiteral "5"] +> ,qeGroupBy = [Iden "a"] +> ,qeHaving = Just $ Op ">" [App "sum" [Iden "b"], NumLit "5"] > }) > ] > orderBy :: TestItem > orderBy = Group "orderBy" $ map (uncurry TestQueryExpr) > [("select a from t order by a" -> ,ms [Identifier "a"]) +> ,ms [Iden "a"]) > ,("select a from t order by a, b" -> ,ms [Identifier "a", Identifier "b"]) +> ,ms [Iden "a", Iden "b"]) > ] > where -> ms o = makeSelect {qeSelectList = [(Nothing,Identifier "a")] +> ms o = makeSelect {qeSelectList = [(Nothing,Iden "a")] > ,qeFrom = [SimpleTableRef "t"] > ,qeOrderBy = o} @@ -213,15 +223,15 @@ > \ having count(1) > 5\n\ > \ order by s" > ,makeSelect -> {qeSelectList = [(Nothing, Identifier "a") -> ,(Just "s", App "sum" [Op "+" [Identifier "c" -> ,Identifier "d"]])] +> {qeSelectList = [(Nothing, Iden "a") +> ,(Just "s", App "sum" [Op "+" [Iden "c" +> ,Iden "d"]])] > ,qeFrom = [SimpleTableRef "t", SimpleTableRef "u"] -> ,qeWhere = Just $ Op ">" [Identifier "a", NumLiteral "5"] -> ,qeGroupBy = [Identifier "a"] -> ,qeHaving = Just $ Op ">" [App "count" [NumLiteral "1"] -> ,NumLiteral "5"] -> ,qeOrderBy = [Identifier "s"] +> ,qeWhere = Just $ Op ">" [Iden "a", NumLit "5"] +> ,qeGroupBy = [Iden "a"] +> ,qeHaving = Just $ Op ">" [App "count" [NumLit "1"] +> ,NumLit "5"] +> ,qeOrderBy = [Iden "s"] > } > ) > ]