From 5e56a4b5606162aa9a9e9f9e4babf5af6a27e1fe Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Fri, 13 Dec 2013 22:38:43 +0200
Subject: [PATCH] implement extract
---
Language/SQL/SimpleSQL/Parser.lhs | 9 ++++++++-
Language/SQL/SimpleSQL/Pretty.lhs | 5 +++++
Tests.lhs | 2 +-
3 files changed, 14 insertions(+), 2 deletions(-)
diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index 3b299b2..1ce6f41 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -172,6 +172,13 @@ to be.
> prefixCast = try (CastOp <$> typeName
> <*> stringLiteral)
+> extract :: P ScalarExpr
+> extract = try (keyword_ "extract") >>
+> parens (makeOp <$> identifierString
+> <*> (keyword_ "from"
+> *> scalarExpr'))
+> where makeOp n e = SpecialOp "extract" [Iden n, e]
+
> inSuffix :: ScalarExpr -> P ScalarExpr
> inSuffix e =
> In
@@ -289,7 +296,7 @@ postgresql handles this
> factor = choice [literal
> ,scase
> ,cast
-> --,extract
+> ,extract
> ,subquery
> ,prefixUnaryOp
> ,try app
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index b3f8b1b..333494c 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -35,6 +35,11 @@ back into SQL source text. It attempts to format the output nicely.
> ,text nm <+> scalarExpr b
> ,text "and" <+> scalarExpr c]
+> scalarExpr (SpecialOp "extract" [a,n]) =
+> text "extract" <> parens (scalarExpr a
+> <+> text "from"
+> <+> scalarExpr n)
+
> scalarExpr (SpecialOp nm es) =
> text nm <+> parens (commaSep $ map scalarExpr es)
diff --git a/Tests.lhs b/Tests.lhs
index 67220e3..d6b7e61 100644
--- a/Tests.lhs
+++ b/Tests.lhs
@@ -168,7 +168,7 @@
> ,("a is similar to b", BinOp "is similar to" (Iden "a") (Iden "b"))
> ,("a is not similar to b", BinOp "is not similar to" (Iden "a") (Iden "b"))
> ,("a overlaps b", BinOp "overlaps" (Iden "a") (Iden "b"))
-> --,("extract(day from t)", SpecialOp "extract" [Iden "day", Iden "t"])
+> ,("extract(day from t)", SpecialOp "extract" [Iden "day", Iden "t"])
> ]
> aggregates :: TestItem