From 045f2be825670343b1be22272a1b1a7c4da3faae Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
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]
+