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