From c102528d5f86de1c70a45d35881e9d444550d508 Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Sun, 16 Aug 2015 20:03:02 +0300
Subject: [PATCH] add create and drop assertion

---
 Language/SQL/SimpleSQL/Parser.lhs             | 17 +++++++++++++++--
 Language/SQL/SimpleSQL/Pretty.lhs             |  8 ++++++++
 Language/SQL/SimpleSQL/Syntax.lhs             |  6 +++---
 .../Language/SQL/SimpleSQL/SQL2011Schema.lhs  | 19 +++++++++++++++++++
 4 files changed, 45 insertions(+), 5 deletions(-)

diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index b7c66e5..347a6ce 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -1460,7 +1460,8 @@ TODO: change style
 >                                  ,createView
 >                                  ,createDomain
 >                                  ,createSequence
->                                  ,createRole]
+>                                  ,createRole
+>                                  ,createAssertion]
 >     ,keyword_ "alter" *> choice [alterTable
 >                                 ,alterDomain
 >                                 ,alterSequence]
@@ -1469,7 +1470,8 @@ TODO: change style
 >                                ,dropView
 >                                ,dropDomain
 >                                ,dropSequence
->                                ,dropRole]
+>                                ,dropRole
+>                                ,dropAssertion]
 >     ,delete
 >     ,truncateSt
 >     ,insert
@@ -1726,6 +1728,17 @@ slightly hacky parser for signed integers
 > dropSequence = keyword_ "sequence" >>
 >     DropSequence <$> names <*> dropBehaviour
 
+> createAssertion :: Parser Statement
+> createAssertion = keyword_ "assertion" >>
+>     CreateAssertion
+>     <$> names
+>     <*> (keyword_ "check" *> parens valueExpr)
+
+
+> dropAssertion :: Parser Statement
+> dropAssertion = keyword_ "assertion" >>
+>     DropAssertion <$> names <*> dropBehaviour
+
 -----------------
 
 = dml
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index 1741ffb..58fb4cc 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -508,6 +508,14 @@ which have been changed to try to improve the layout of the output.
 > statement _ (DropSequence nm db) =
 >     text "drop" <+> text "sequence" <+> names nm <+> dropBehav db
 
+
+> statement d (CreateAssertion nm ex) =
+>   texts ["create","assertion"] <+> names nm
+>   <+> text "check" <+> parens (valueExpr d ex)
+
+> statement _ (DropAssertion nm db) =
+>     text "drop" <+> text "assertion" <+> names nm <+> dropBehav db
+
 == dml
 
 > statement d (SelectStatement q) = queryExpr d q
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index 8c31ee5..2cb7f1b 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -431,9 +431,9 @@ I'm not sure if this is valid syntax or not.
 >   | DropCollation
 >   | CreateTranslation
 >   | DropTranslation -}
->   {-  | CreateAssertion
->   | DropAssertion
->   | CreateTrigger
+>   | CreateAssertion [Name] ValueExpr
+>   | DropAssertion [Name] DropBehaviour
+>   {-   | CreateTrigger
 >   | DropTrigger
 >   | CreateType
 >   | AlterType
diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs b/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs
index eb11f35..145c9a4 100644
--- a/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs
+++ b/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs
@@ -1332,11 +1332,30 @@ defintely skip
          CHECK <left paren> <search condition> <right paren>
          [ <constraint characteristics> ]
 
+>     ,(TestStatement SQL2011
+>       "create assertion t1_not_empty CHECK ((select count(*) from t1) > 0);"
+>      $ CreateAssertion [Name "t1_not_empty"]
+>         $ BinOp (SubQueryExpr SqSq $
+>                  makeSelect
+>                  {qeSelectList = [(App [Name "count"] [Star],Nothing)]
+>                  ,qeFrom = [TRSimple [Name "t1"]]
+>                  })
+>                 [Name ">"] (NumLit "0"))
+
 11.48 <drop assertion statement>
 
 <drop assertion statement> ::=
   DROP ASSERTION <constraint name> [ <drop behavior> ]
 
+>     ,(TestStatement SQL2011
+>       "drop assertion t1_not_empty;"
+>      $ DropAssertion [Name "t1_not_empty"] DefaultDropBehaviour)
+
+>     ,(TestStatement SQL2011
+>       "drop assertion t1_not_empty cascade;"
+>      $ DropAssertion [Name "t1_not_empty"] Cascade)
+
+
 11.49 <trigger definition>
 
 <trigger definition> ::=