From c2810cddd2e966ece922bd37e00a8122adbdc4bc Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Sun, 2 Aug 2015 23:52:01 +0300
Subject: [PATCH] add support for create and drop view

---
 Language/SQL/SimpleSQL/Parser.lhs             | 28 ++++++++-
 Language/SQL/SimpleSQL/Pretty.lhs             | 16 ++++++
 Language/SQL/SimpleSQL/Syntax.lhs             | 19 ++++---
 .../Language/SQL/SimpleSQL/SQL2011Schema.lhs  | 57 +++++++++++++++++++
 4 files changed, 110 insertions(+), 10 deletions(-)

diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index 54367ec..a7aeffa 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -1442,10 +1442,12 @@ TODO: change style
 > statement :: Parser Statement
 > statement = choice
 >     [keyword_ "create" *> choice [createSchema
->                                  ,createTable]
+>                                  ,createTable
+>                                  ,createView]
 >     ,keyword_ "alter" *> choice [alterTable]
 >     ,keyword_ "drop" *> choice [dropSchema
->                                ,dropTable]
+>                                ,dropTable
+>                                ,dropView]
 >     ,delete
 >     ,truncateSt
 >     ,insert
@@ -1618,6 +1620,28 @@ slightly hacky parser for signed integers
 > dropTable = keyword_ "table" >>
 >     DropTable <$> names <*> dropBehaviour
 
+> createView :: Parser Statement
+> createView =
+>     CreateView
+>     <$> (option False (True <$ keyword_ "recursive") <* keyword_ "view")
+>     <*> names
+>     <*> optionMaybe (parens (commaSep1 name))
+>     <*> (keyword_ "as" *> queryExpr)
+>     <*> optionMaybe (choice [
+>             -- todo: left factor
+>             DefaultCheckOption <$ try (keywords_ ["with", "check", "option"])
+>            ,CascadedCheckOption <$ try (keywords_ ["with", "cascaded", "check", "option"])
+>            ,LocalCheckOption <$ try (keywords_ ["with", "local", "check", "option"])
+>             ])
+
+> dropView :: Parser Statement
+> dropView = keyword_ "view" >>
+>     DropView <$> names <*> dropBehaviour
+
+
+-----------------
+
+= dml
 
 > delete :: Parser Statement
 > delete = keywords_ ["delete","from"] >>
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index 5d0e8c0..9779c87 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -505,6 +505,22 @@ which have been changed to try to improve the layout of the output.
 > statement _ (DropTable n b) =
 >     text "drop" <+> text "table" <+> names n <+> dropBehav b
 
+> statement d (CreateView r nm al q co) =
+>     text "create" <+> (if r then text "recursive" else empty)
+>     <+> text "view" <+> names nm
+>     <+> (maybe empty (\al' -> parens $ commaSep $ map name al')) al
+>     <+> text "as"
+>     <+> queryExpr d q
+>     <+> case co of
+>             Nothing -> empty
+>             Just DefaultCheckOption -> texts ["with", "check", "option"]
+>             Just CascadedCheckOption -> texts ["with", "cascaded", "check", "option"]
+>             Just LocalCheckOption -> texts ["with", "local", "check", "option"]
+
+> statement _ (DropView n b) =
+>     text "drop" <+> text "view" <+> names n <+> dropBehav b
+
+
 == access control
 
 == transactions
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index 44b2f36..ef679f8 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -47,6 +47,7 @@
 >     ,ReferenceMatch(..)
 >     ,ReferentialAction(..)
 >     ,AlterTableAction(..)
+>     ,CheckOption(..)
 >      -- * Dialect
 >     ,Dialect(..)
 >      -- * Comment
@@ -406,9 +407,10 @@ I'm not sure if this is valid syntax or not.
 >   | CreateTable [Name] [TableElement]
 >   | AlterTable [Name] AlterTableAction
 >   | DropTable [Name] DropBehaviour
->   {-  | CreateView
->   | DropView
->   | CreateDomain
+>   | CreateView Bool [Name] (Maybe [Name])
+>         QueryExpr (Maybe CheckOption)
+>   | DropView [Name]  DropBehaviour
+>   {-  | CreateDomain
 >   | AlterDomain
 >   | DropDomain
 >   | CreateCharacterSet
@@ -617,11 +619,12 @@ I'm not sure if this is valid syntax or not.
 >   | SGONoCycle
 >     deriving (Eq,Show,Read,Data,Typeable)
 
-> {-data ColumnConstraintDef =
->     | NotNullConstraint
->     | UniqueConstraint
->     | ReferencesConstraint
->     | CheckConstraint-}
+> data CheckOption =
+>     DefaultCheckOption
+>   | CascadedCheckOption
+>   | LocalCheckOption
+>     deriving (Eq,Show,Read,Data,Typeable)
+
 
 --------------------------
 
diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs b/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs
index 6727347..075c124 100644
--- a/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs
+++ b/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs
@@ -1078,11 +1078,68 @@ defintely skip
 <view column list> ::=
   <column name list>
 
+>     ,(TestStatement SQL2011
+>       "create view v as select * from t"
+>      $ CreateView False [Name "v"] Nothing (makeSelect
+>          {qeSelectList = [(Star, Nothing)]
+>          ,qeFrom = [TRSimple [Name "t"]]
+>          }) Nothing)
+
+
+>     ,(TestStatement SQL2011
+>       "create recursive view v as select * from t"
+>      $ CreateView True [Name "v"] Nothing (makeSelect
+>          {qeSelectList = [(Star, Nothing)]
+>          ,qeFrom = [TRSimple [Name "t"]]
+>          }) Nothing)
+
+>     ,(TestStatement SQL2011
+>       "create view v(a,b) as select * from t"
+>      $ CreateView False [Name "v"] (Just [Name "a", Name "b"])
+>          (makeSelect
+>          {qeSelectList = [(Star, Nothing)]
+>          ,qeFrom = [TRSimple [Name "t"]]
+>          }) Nothing)
+
+
+>     ,(TestStatement SQL2011
+>       "create view v as select * from t with check option"
+>      $ CreateView False [Name "v"] Nothing (makeSelect
+>          {qeSelectList = [(Star, Nothing)]
+>          ,qeFrom = [TRSimple [Name "t"]]
+>          }) (Just DefaultCheckOption))
+
+>     ,(TestStatement SQL2011
+>       "create view v as select * from t with cascaded check option"
+>      $ CreateView False [Name "v"] Nothing (makeSelect
+>          {qeSelectList = [(Star, Nothing)]
+>          ,qeFrom = [TRSimple [Name "t"]]
+>          }) (Just CascadedCheckOption))
+
+>     ,(TestStatement SQL2011
+>       "create view v as select * from t with local check option"
+>      $ CreateView False [Name "v"] Nothing
+>          (makeSelect
+>          {qeSelectList = [(Star, Nothing)]
+>          ,qeFrom = [TRSimple [Name "t"]]
+>          }) (Just LocalCheckOption))
+
+
 11.33 <drop view statement>
 
 <drop view statement> ::=
   DROP VIEW <table name> <drop behavior>
 
+
+>     ,(TestStatement SQL2011
+>       "drop view v"
+>      $ DropView [Name "v"] DefaultDropBehaviour)
+
+>     ,(TestStatement SQL2011
+>       "drop view v cascade"
+>      $ DropView [Name "v"] Cascade)
+
+
 11.34 <domain definition>
 
 <domain definition> ::=