From 045f2be825670343b1be22272a1b1a7c4da3faae Mon Sep 17 00:00:00 2001 From: Jake Wheat Date: Tue, 17 Dec 2013 12:51:14 +0200 Subject: [PATCH] support simple interval literal interval '3 days' and rename CastOp to TypedLit --- Language/SQL/SimpleSQL/Fixity.lhs | 2 +- Language/SQL/SimpleSQL/Parser.lhs | 10 +++++++--- Language/SQL/SimpleSQL/Pretty.lhs | 2 +- Language/SQL/SimpleSQL/Syntax.lhs | 2 +- tools/Language/SQL/SimpleSQL/Postgres.lhs | 8 ++++---- tools/Language/SQL/SimpleSQL/ScalarExprs.lhs | 5 +++-- tools/RunTests.lhs | 1 + 7 files changed, 18 insertions(+), 12 deletions(-) diff --git a/Language/SQL/SimpleSQL/Fixity.lhs b/Language/SQL/SimpleSQL/Fixity.lhs index 67521a5..eb214e6 100644 --- a/Language/SQL/SimpleSQL/Fixity.lhs +++ b/Language/SQL/SimpleSQL/Fixity.lhs @@ -107,7 +107,7 @@ the fixity code. > ,HSE.List $ map (ltoh . (\(a,b) -> [a,b])) ts > ,ltoh $ maybeToList el]) > Cast e0 tn -> HSE.App (str ('c':show tn)) $ toHaskell e0 -> CastOp {} -> str ('v':show e) +> TypedLit {} -> str ('v':show e) > SubQueryExpr {} -> str ('v': show e) > In b e0 (InList l) -> > HSE.App (str ('i':show b)) diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs index e00e888..e6f0b77 100644 --- a/Language/SQL/SimpleSQL/Parser.lhs +++ b/Language/SQL/SimpleSQL/Parser.lhs @@ -99,12 +99,16 @@ interval '5' day (3) or interval '5' month +wrap the whole lot in try, in case we get something like this: +interval '3 days' +which parses as a typed literal + > interval :: P ScalarExpr -> interval = try (keyword_ "interval") >> +> interval = try (keyword_ "interval" >> > IntervalLit > <$> stringLiteral > <*> identifierString -> <*> optionMaybe (try $ parens integerLiteral) +> <*> optionMaybe (try $ parens integerLiteral)) > literal :: P ScalarExpr > literal = number <|> estring <|> interval @@ -210,7 +214,7 @@ cast: cast(expr as type) > parensCast = try (keyword_ "cast") >> > parens (Cast <$> scalarExpr' > <*> (keyword_ "as" *> typeName)) -> prefixCast = try (CastOp <$> typeName +> prefixCast = try (TypedLit <$> typeName > <*> stringLiteral) extract(id from expr) diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 62de7e5..12791cb 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/Language/SQL/SimpleSQL/Pretty.lhs @@ -111,7 +111,7 @@ > ,text "as" > ,text tn]) -> scalarExpr (CastOp (TypeName tn) s) = +> scalarExpr (TypedLit (TypeName tn) s) = > text tn <+> quotes (text s) > scalarExpr (SubQueryExpr ty qe) = diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index 43f5fcd..bb55330 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/Language/SQL/SimpleSQL/Syntax.lhs @@ -88,7 +88,7 @@ > -- | cast(a as typename) > | Cast ScalarExpr TypeName > -- | prefix 'typed literal', e.g. int '42' -> | CastOp TypeName String +> | TypedLit TypeName String > -- | exists, all, any, some subqueries > | SubQueryExpr SubQueryExprType QueryExpr > -- | in list literal and in subquery, if the bool is false it diff --git a/tools/Language/SQL/SimpleSQL/Postgres.lhs b/tools/Language/SQL/SimpleSQL/Postgres.lhs index 39b6a61..198630e 100644 --- a/tools/Language/SQL/SimpleSQL/Postgres.lhs +++ b/tools/Language/SQL/SimpleSQL/Postgres.lhs @@ -104,11 +104,11 @@ queries section > ,"SELECT x, sum(y) FROM test1 GROUP BY x HAVING sum(y) > 3;" > ,"SELECT x, sum(y) FROM test1 GROUP BY x HAVING x < 'c';" -> {-,"SELECT product_id, p.name, (sum(s.units) * (p.price - p.cost)) AS profit\n\ +> ,"SELECT product_id, p.name, (sum(s.units) * (p.price - p.cost)) AS profit\n\ > \ FROM products p LEFT JOIN sales s USING (product_id)\n\ > \ WHERE s.date > CURRENT_DATE - INTERVAL '4 weeks'\n\ > \ GROUP BY product_id, p.name, p.price, p.cost\n\ -> \ HAVING sum(p.price * s.units) > 5000;"-} -- interval syntax? +> \ HAVING sum(p.price * s.units) > 5000;" > ,"SELECT a, b, c FROM t" @@ -219,10 +219,10 @@ select page reference > \ FROM distributors d, films f\n\ > \ WHERE f.did = d.did" -> {-,"SELECT kind, sum(len) AS total\n\ +> ,"SELECT kind, sum(len) AS total\n\ > \ FROM films\n\ > \ GROUP BY kind\n\ -> \ HAVING sum(len) < interval '5 hours';"-} -- interval syntax? +> \ HAVING sum(len) < interval '5 hours';" > ,"SELECT * FROM distributors ORDER BY name;" > ,"SELECT * FROM distributors ORDER BY 2;" diff --git a/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs b/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs index 6a78167..7a2a114 100644 --- a/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs +++ b/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs @@ -36,6 +36,7 @@ Tests for parsing scalar expressions > ,("'1'", StringLit "1") > ,("interval '3' day", IntervalLit "3" "day" Nothing) > ,("interval '3' day (3)", IntervalLit "3" "day" $ Just 3) +> ,("interval '3 weeks'", TypedLit (TypeName "interval") "3 weeks") > ] > identifiers :: TestItem @@ -116,13 +117,13 @@ Tests for parsing scalar expressions > ,Cast (StringLit "1") $ TypeName "int") > ,("int '3'" -> ,CastOp (TypeName "int") "3") +> ,TypedLit (TypeName "int") "3") > ,("cast('1' as double precision)" > ,Cast (StringLit "1") $ TypeName "double precision") > ,("double precision '3'" -> ,CastOp (TypeName "double precision") "3") +> ,TypedLit (TypeName "double precision") "3") > ] > subqueries :: TestItem diff --git a/tools/RunTests.lhs b/tools/RunTests.lhs index 560079a..f8f916f 100644 --- a/tools/RunTests.lhs +++ b/tools/RunTests.lhs @@ -6,3 +6,4 @@ > main :: IO () > main = defaultMain [tests] +