starlitcanopy/simple-sql-parser
1
Fork 0
Code Activity

implement complete base 10 number parser, shorten some syntax names

Browse source
This commit is contained in:
Jake Wheat 2013-12-13 17:00:22 +02:00
parent 63fe9778f7
commit 2c1eedb70f
4 changed files with 116 additions and 84 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

58
Language/SQL/SimpleSQL/Parser.lhs
View file

@ -31,13 +31,35 @@
= scalar expressions = scalar expressions
> estring :: P ScalarExpr > 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 :: P ScalarExpr
> literal = integer <|> estring > literal = number <|> estring
> identifierString :: P String > identifierString :: P String
> identifierString = do > identifierString = do
@ -57,10 +79,10 @@ TODO: talk about what must be in the blacklist, and what doesn't need
to be. to be.
> identifier :: P ScalarExpr > identifier :: P ScalarExpr
> identifier = Identifier <$> identifierString > identifier = Iden <$> identifierString
> dottedIdentifier :: P ScalarExpr > dottedIden :: P ScalarExpr
> dottedIdentifier = Identifier2 <$> identifierString > dottedIden = Iden2 <$> identifierString
> <*> (symbol "." *> identifierString) > <*> (symbol "." *> identifierString)
> star :: P ScalarExpr > star :: P ScalarExpr
@ -104,7 +126,7 @@ to be.
> ,scase > ,scase
> ,unaryOp > ,unaryOp
> ,try app > ,try app
> ,try dottedIdentifier > ,try dottedIden
> ,identifier > ,identifier
> ,sparens] > ,sparens]
> trysuffix e = try (suffix e) <|> return e > trysuffix e = try (suffix e) <|> return e
@ -118,21 +140,21 @@ to be.
> toHaskell :: ScalarExpr -> HSE.Exp > toHaskell :: ScalarExpr -> HSE.Exp
> toHaskell e = case e of > toHaskell e = case e of
> Identifier i -> HSE.Var $ HSE.UnQual $ HSE.Ident i > Iden i -> HSE.Var $ HSE.UnQual $ HSE.Ident i
> StringLiteral l -> HSE.Lit $ HSE.String $ 's':l > StringLit l -> HSE.Lit $ HSE.String $ 's':l
> NumLiteral l -> HSE.Lit $ HSE.String $ 'n':l > NumLit l -> HSE.Lit $ HSE.String $ 'n':l
> App n es -> HSE.App (toHaskell $ Identifier n) $ ltoh es > App n es -> HSE.App (toHaskell $ Iden n) $ ltoh es
> Op n [e0,e1] -> HSE.InfixApp (toHaskell e0) > Op n [e0,e1] -> HSE.InfixApp (toHaskell e0)
> (HSE.QVarOp $ HSE.UnQual $ HSE.Ident n) > (HSE.QVarOp $ HSE.UnQual $ HSE.Ident n)
> (toHaskell e1) > (toHaskell e1)
> Op "not" [e0] -> toHaskell $ App "not" [e0] > Op "not" [e0] -> toHaskell $ App "not" [e0]
> Op {} -> error $ "bad args to operator " ++ groom e > Op {} -> error $ "bad args to operator " ++ groom e
> Star -> HSE.Var $ HSE.UnQual $ HSE.Ident "*" > 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 "*") > Star2 q -> HSE.Var $ HSE.Qual (HSE.ModuleName q) (HSE.Ident "*")
> Parens e0 -> HSE.Paren $ toHaskell e0 > Parens e0 -> HSE.Paren $ toHaskell e0
> -- map the two maybes to lists with either 0 or 1 element > -- 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 [ltoh $ maybeToList v
> ,HSE.List $ map (ltoh . (\(a,b) -> [a,b])) ts > ,HSE.List $ map (ltoh . (\(a,b) -> [a,b])) ts
> ,ltoh $ maybeToList el]) > ,ltoh $ maybeToList el])
@ -143,10 +165,10 @@ to be.
> toSql e = case e of > toSql e = case e of
> HSE.Var (HSE.UnQual (HSE.Ident "*")) -> Star > HSE.Var (HSE.UnQual (HSE.Ident "*")) -> Star
> HSE.Var (HSE.Qual (HSE.ModuleName q) (HSE.Ident "*")) -> Star2 q > 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.Qual (HSE.ModuleName a) (HSE.Ident b)) -> Iden2 a b
> HSE.Var (HSE.UnQual (HSE.Ident i)) -> Identifier i > HSE.Var (HSE.UnQual (HSE.Ident i)) -> Iden i
> HSE.Lit (HSE.String ('s':l)) -> StringLiteral l > HSE.Lit (HSE.String ('s':l)) -> StringLit l
> HSE.Lit (HSE.String ('n':l)) -> NumLiteral l > HSE.Lit (HSE.String ('n':l)) -> NumLit l
> HSE.App (HSE.Var (HSE.UnQual (HSE.Ident "$case"))) (HSE.List [v,ts,el]) -> > HSE.App (HSE.Var (HSE.UnQual (HSE.Ident "$case"))) (HSE.List [v,ts,el]) ->
> Case (ltom v) (pairs ts) (ltom el) > Case (ltom v) (pairs ts) (ltom el)
> HSE.App (HSE.Var (HSE.UnQual (HSE.Ident "not"))) > HSE.App (HSE.Var (HSE.UnQual (HSE.Ident "not")))

8
Language/SQL/SimpleSQL/Pretty.lhs
View file

@ -21,10 +21,10 @@ back into SQL source text. It attempts to format the output nicely.
= scalar expressions = scalar expressions
> scalarExpr :: ScalarExpr -> Doc > scalarExpr :: ScalarExpr -> Doc
> scalarExpr (StringLiteral s) = quotes $ text s > scalarExpr (StringLit s) = quotes $ text s
> scalarExpr (NumLiteral s) = text s > scalarExpr (NumLit s) = text s
> scalarExpr (Identifier i) = text i > scalarExpr (Iden i) = text i
> scalarExpr (Identifier2 q i) = text q <> text "." <> text i > scalarExpr (Iden2 q i) = text q <> text "." <> text i
> scalarExpr Star = text "*" > scalarExpr Star = text "*"
> scalarExpr (Star2 q) = text q <> text "." <> text "*" > scalarExpr (Star2 q) = text q <> text "." <> text "*"

8
Language/SQL/SimpleSQL/Syntax.lhs
View file

@ -9,10 +9,10 @@
> ) where > ) where
> data ScalarExpr = NumLiteral String > data ScalarExpr = NumLit String
> | StringLiteral String > | StringLit String
> | Identifier String > | Iden String
> | Identifier2 String String > | Iden2 String String
> | Star > | Star
> | Star2 String > | Star2 String
> | App String [ScalarExpr] > | App String [ScalarExpr]

126
Tests.lhs
View file

@ -25,14 +25,24 @@
> literals :: TestItem > literals :: TestItem
> literals = Group "literals" $ map (uncurry TestScalarExpr) > literals = Group "literals" $ map (uncurry TestScalarExpr)
> [("3", NumLiteral "3") > [("3", NumLit "3")
> ,("'string'", StringLiteral "string") > ,("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 :: TestItem
> identifiers = Group "identifiers" $ map (uncurry TestScalarExpr) > identifiers = Group "identifiers" $ map (uncurry TestScalarExpr)
> [("iden1", Identifier "iden1") > [("iden1", Iden "iden1")
> ,("t.a", Identifier2 "t" "a") > ,("t.a", Iden2 "t" "a")
> ] > ]
> star :: TestItem > star :: TestItem
@ -44,37 +54,37 @@
> app :: TestItem > app :: TestItem
> app = Group "app" $ map (uncurry TestScalarExpr) > app = Group "app" $ map (uncurry TestScalarExpr)
> [("f()", App "f" []) > [("f()", App "f" [])
> ,("f(a)", App "f" [Identifier "a"]) > ,("f(a)", App "f" [Iden "a"])
> ,("f(a,b)", App "f" [Identifier "a", Identifier "b"]) > ,("f(a,b)", App "f" [Iden "a", Iden "b"])
> ] > ]
> caseexp :: TestItem > caseexp :: TestItem
> caseexp = Group "caseexp" $ map (uncurry TestScalarExpr) > caseexp = Group "caseexp" $ map (uncurry TestScalarExpr)
> [("case a when 1 then 2 end" > [("case a when 1 then 2 end"
> ,Case (Just $ Identifier "a") [(NumLiteral "1" > ,Case (Just $ Iden "a") [(NumLit "1"
> ,NumLiteral "2")] Nothing) > ,NumLit "2")] Nothing)
> ,("case a when 1 then 2 when 3 then 4 end" > ,("case a when 1 then 2 when 3 then 4 end"
> ,Case (Just $ Identifier "a") [(NumLiteral "1", NumLiteral "2") > ,Case (Just $ Iden "a") [(NumLit "1", NumLit "2")
> ,(NumLiteral "3", NumLiteral "4")] Nothing) > ,(NumLit "3", NumLit "4")] Nothing)
> ,("case a when 1 then 2 when 3 then 4 else 5 end" > ,("case a when 1 then 2 when 3 then 4 else 5 end"
> ,Case (Just $ Identifier "a") [(NumLiteral "1", NumLiteral "2") > ,Case (Just $ Iden "a") [(NumLit "1", NumLit "2")
> ,(NumLiteral "3", NumLiteral "4")] (Just $ NumLiteral "5")) > ,(NumLit "3", NumLit "4")] (Just $ NumLit "5"))
> ,("case when a=1 then 2 when a=3 then 4 else 5 end" > ,("case when a=1 then 2 when a=3 then 4 else 5 end"
> ,Case Nothing [(Op "=" [Identifier "a", NumLiteral "1"], NumLiteral "2") > ,Case Nothing [(Op "=" [Iden "a", NumLit "1"], NumLit "2")
> ,(Op "=" [Identifier "a",NumLiteral "3"], NumLiteral "4")] > ,(Op "=" [Iden "a",NumLit "3"], NumLit "4")]
> (Just $ NumLiteral "5")) > (Just $ NumLit "5"))
> ] > ]
> operators :: TestItem > operators :: TestItem
> operators = Group "operators" $ map (uncurry TestScalarExpr) > operators = Group "operators" $ map (uncurry TestScalarExpr)
> [("a + b", Op "+" [Identifier "a", Identifier "b"]) > [("a + b", Op "+" [Iden "a", Iden "b"])
> ,("not not a", Op "not" [Op "not" [Identifier "a"]]) > ,("not not a", Op "not" [Op "not" [Iden "a"]])
> ] > ]
> parens :: TestItem > parens :: TestItem
> parens = Group "parens" $ map (uncurry TestScalarExpr) > parens = Group "parens" $ map (uncurry TestScalarExpr)
> [("(a)", Parens (Identifier "a")) > [("(a)", Parens (Iden "a"))
> ,("(a + b)", Parens (Op "+" [Identifier "a", Identifier "b"])) > ,("(a + b)", Parens (Op "+" [Iden "a", Iden "b"]))
> ] > ]
> queryExprParserTests :: TestItem > queryExprParserTests :: TestItem
@ -91,22 +101,22 @@
> selectLists :: TestItem > selectLists :: TestItem
> selectLists = Group "selectLists" $ map (uncurry TestQueryExpr) > selectLists = Group "selectLists" $ map (uncurry TestQueryExpr)
> [("select 1", > [("select 1",
> makeSelect {qeSelectList = [(Nothing,NumLiteral "1")]}) > makeSelect {qeSelectList = [(Nothing,NumLit "1")]})
> ,("select a" > ,("select a"
> ,makeSelect {qeSelectList = [(Nothing,Identifier "a")]}) > ,makeSelect {qeSelectList = [(Nothing,Iden "a")]})
> ,("select a,b" > ,("select a,b"
> ,makeSelect {qeSelectList = [(Nothing,Identifier "a") > ,makeSelect {qeSelectList = [(Nothing,Iden "a")
> ,(Nothing,Identifier "b")]}) > ,(Nothing,Iden "b")]})
> ,("select 1+2,3+4" > ,("select 1+2,3+4"
> ,makeSelect {qeSelectList = > ,makeSelect {qeSelectList =
> [(Nothing,Op "+" [NumLiteral "1",NumLiteral "2"]) > [(Nothing,Op "+" [NumLit "1",NumLit "2"])
> ,(Nothing,Op "+" [NumLiteral "3",NumLiteral "4"])]}) > ,(Nothing,Op "+" [NumLit "3",NumLit "4"])]})
> ,("select a as a, /*comment*/ b as b" > ,("select a as a, /*comment*/ b as b"
> ,makeSelect {qeSelectList = [(Just "a", Identifier "a") > ,makeSelect {qeSelectList = [(Just "a", Iden "a")
> ,(Just "b", Identifier "b")]}) > ,(Just "b", Iden "b")]})
> ,("select a a, b b" > ,("select a a, b b"
> ,makeSelect {qeSelectList = [(Just "a", Identifier "a") > ,makeSelect {qeSelectList = [(Just "a", Iden "a")
> ,(Just "b", Identifier "b")]}) > ,(Just "b", Iden "b")]})
> ] > ]
> from :: TestItem > from :: TestItem
@ -117,16 +127,16 @@
> ,ms [SimpleTableRef "t", SimpleTableRef "u"]) > ,ms [SimpleTableRef "t", SimpleTableRef "u"])
> ,("select a from t inner join u on expr" > ,("select a from t inner join u on expr"
> ,ms [JoinTableRef Inner (SimpleTableRef "t") (SimpleTableRef "u") > ,ms [JoinTableRef Inner (SimpleTableRef "t") (SimpleTableRef "u")
> (Just $ JoinOn $ Identifier "expr")]) > (Just $ JoinOn $ Iden "expr")])
> ,("select a from t left join u on expr" > ,("select a from t left join u on expr"
> ,ms [JoinTableRef JLeft (SimpleTableRef "t") (SimpleTableRef "u") > ,ms [JoinTableRef JLeft (SimpleTableRef "t") (SimpleTableRef "u")
> (Just $ JoinOn $ Identifier "expr")]) > (Just $ JoinOn $ Iden "expr")])
> ,("select a from t right join u on expr" > ,("select a from t right join u on expr"
> ,ms [JoinTableRef JRight (SimpleTableRef "t") (SimpleTableRef "u") > ,ms [JoinTableRef JRight (SimpleTableRef "t") (SimpleTableRef "u")
> (Just $ JoinOn $ Identifier "expr")]) > (Just $ JoinOn $ Iden "expr")])
> ,("select a from t full join u on expr" > ,("select a from t full join u on expr"
> ,ms [JoinTableRef Full (SimpleTableRef "t") (SimpleTableRef "u") > ,ms [JoinTableRef Full (SimpleTableRef "t") (SimpleTableRef "u")
> (Just $ JoinOn $ Identifier "expr")]) > (Just $ JoinOn $ Iden "expr")])
> ,("select a from t cross join u" > ,("select a from t cross join u"
> ,ms [JoinTableRef Cross (SimpleTableRef "t") > ,ms [JoinTableRef Cross (SimpleTableRef "t")
> (SimpleTableRef "u") Nothing]) > (SimpleTableRef "u") Nothing])
@ -147,54 +157,54 @@
> (SimpleTableRef "u") Nothing) "u"]) > (SimpleTableRef "u") Nothing) "u"])
> ] > ]
> where > where
> ms f = makeSelect {qeSelectList = [(Nothing,Identifier "a")] > ms f = makeSelect {qeSelectList = [(Nothing,Iden "a")]
> ,qeFrom = f} > ,qeFrom = f}
> whereClause :: TestItem > whereClause :: TestItem
> whereClause = Group "whereClause" $ map (uncurry TestQueryExpr) > whereClause = Group "whereClause" $ map (uncurry TestQueryExpr)
> [("select a from t where a = 5" > [("select a from t where a = 5"
> ,makeSelect {qeSelectList = [(Nothing,Identifier "a")] > ,makeSelect {qeSelectList = [(Nothing,Iden "a")]
> ,qeFrom = [SimpleTableRef "t"] > ,qeFrom = [SimpleTableRef "t"]
> ,qeWhere = Just $ Op "=" [Identifier "a", NumLiteral "5"]}) > ,qeWhere = Just $ Op "=" [Iden "a", NumLit "5"]})
> ] > ]
> groupByClause :: TestItem > groupByClause :: TestItem
> groupByClause = Group "groupByClause" $ map (uncurry TestQueryExpr) > groupByClause = Group "groupByClause" $ map (uncurry TestQueryExpr)
> [("select a,sum(b) from t group by a" > [("select a,sum(b) from t group by a"
> ,makeSelect {qeSelectList = [(Nothing, Identifier "a") > ,makeSelect {qeSelectList = [(Nothing, Iden "a")
> ,(Nothing, App "sum" [Identifier "b"])] > ,(Nothing, App "sum" [Iden "b"])]
> ,qeFrom = [SimpleTableRef "t"] > ,qeFrom = [SimpleTableRef "t"]
> ,qeGroupBy = [Identifier "a"] > ,qeGroupBy = [Iden "a"]
> }) > })
> ,("select a,b,sum(c) from t group by a,b" > ,("select a,b,sum(c) from t group by a,b"
> ,makeSelect {qeSelectList = [(Nothing, Identifier "a") > ,makeSelect {qeSelectList = [(Nothing, Iden "a")
> ,(Nothing, Identifier "b") > ,(Nothing, Iden "b")
> ,(Nothing, App "sum" [Identifier "c"])] > ,(Nothing, App "sum" [Iden "c"])]
> ,qeFrom = [SimpleTableRef "t"] > ,qeFrom = [SimpleTableRef "t"]
> ,qeGroupBy = [Identifier "a",Identifier "b"] > ,qeGroupBy = [Iden "a",Iden "b"]
> }) > })
> ] > ]
> having :: TestItem > having :: TestItem
> having = Group "having" $ map (uncurry TestQueryExpr) > having = Group "having" $ map (uncurry TestQueryExpr)
> [("select a,sum(b) from t group by a having sum(b) > 5" > [("select a,sum(b) from t group by a having sum(b) > 5"
> ,makeSelect {qeSelectList = [(Nothing, Identifier "a") > ,makeSelect {qeSelectList = [(Nothing, Iden "a")
> ,(Nothing, App "sum" [Identifier "b"])] > ,(Nothing, App "sum" [Iden "b"])]
> ,qeFrom = [SimpleTableRef "t"] > ,qeFrom = [SimpleTableRef "t"]
> ,qeGroupBy = [Identifier "a"] > ,qeGroupBy = [Iden "a"]
> ,qeHaving = Just $ Op ">" [App "sum" [Identifier "b"], NumLiteral "5"] > ,qeHaving = Just $ Op ">" [App "sum" [Iden "b"], NumLit "5"]
> }) > })
> ] > ]
> orderBy :: TestItem > orderBy :: TestItem
> orderBy = Group "orderBy" $ map (uncurry TestQueryExpr) > orderBy = Group "orderBy" $ map (uncurry TestQueryExpr)
> [("select a from t order by a" > [("select a from t order by a"
> ,ms [Identifier "a"]) > ,ms [Iden "a"])
> ,("select a from t order by a, b" > ,("select a from t order by a, b"
> ,ms [Identifier "a", Identifier "b"]) > ,ms [Iden "a", Iden "b"])
> ] > ]
> where > where
> ms o = makeSelect {qeSelectList = [(Nothing,Identifier "a")] > ms o = makeSelect {qeSelectList = [(Nothing,Iden "a")]
> ,qeFrom = [SimpleTableRef "t"] > ,qeFrom = [SimpleTableRef "t"]
> ,qeOrderBy = o} > ,qeOrderBy = o}
@ -213,15 +223,15 @@
> \ having count(1) > 5\n\ > \ having count(1) > 5\n\
> \ order by s" > \ order by s"
> ,makeSelect > ,makeSelect
> {qeSelectList = [(Nothing, Identifier "a") > {qeSelectList = [(Nothing, Iden "a")
> ,(Just "s", App "sum" [Op "+" [Identifier "c" > ,(Just "s", App "sum" [Op "+" [Iden "c"
> ,Identifier "d"]])] > ,Iden "d"]])]
> ,qeFrom = [SimpleTableRef "t", SimpleTableRef "u"] > ,qeFrom = [SimpleTableRef "t", SimpleTableRef "u"]
> ,qeWhere = Just $ Op ">" [Identifier "a", NumLiteral "5"] > ,qeWhere = Just $ Op ">" [Iden "a", NumLit "5"]
> ,qeGroupBy = [Identifier "a"] > ,qeGroupBy = [Iden "a"]
> ,qeHaving = Just $ Op ">" [App "count" [NumLiteral "1"] > ,qeHaving = Just $ Op ">" [App "count" [NumLit "1"]
> ,NumLiteral "5"] > ,NumLit "5"]
> ,qeOrderBy = [Identifier "s"] > ,qeOrderBy = [Iden "s"]
> } > }
> ) > )
> ] > ]