implement complete base 10 number parser, shorten some syntax names
This commit is contained in:
Jake Wheat
parent
63fe9778f7
commit
2c1eedb70f
|
|
@ -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")))
|
||||
|
|
|
|||
|
|
@ -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 "*"
|
||||
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
126
Tests.lhs
126
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"]
|
||||
> }
|
||||
> )
|
||||
> ]
|
||||
|
|
|
|||
Loading…
Reference in a new issue