From e495e240c041d30d279ec9fe780d98f3713fa76b Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Sun, 2 Aug 2015 18:04:40 +0300
Subject: [PATCH] add default and identity to create table

---
 Language/SQL/SimpleSQL/Parser.lhs             |  45 +++++
 Language/SQL/SimpleSQL/Pretty.lhs             |  31 +++-
 Language/SQL/SimpleSQL/Syntax.lhs             |  31 +++-
 .../Language/SQL/SimpleSQL/SQL2011Schema.lhs  | 169 +++++++++++++++++-
 4 files changed, 260 insertions(+), 16 deletions(-)

diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index bd84430..4eddec6 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -1468,6 +1468,51 @@ TODO: change style
 >     <*> parens (commaSep1 columnDef)
 >   where
 >     columnDef = ColumnDef <$> name <*> typeName
+>                 <*> optionMaybe defaultClause
+>     defaultClause = choice [
+>         keyword_ "default" >>
+>         DefaultClause <$> valueExpr
+>        ,keyword_ "generated" >>
+>         IdentityColumnSpec
+>         <$> option GeneratedDefault
+>             (GeneratedAlways <$ keyword_ "always"
+>              <|> GeneratedByDefault <$ keywords_ ["by", "default"])
+>         <*> (keywords_ ["as", "identity"] *>
+>              option [] (parens sequenceGeneratorOptions))
+>        ]
+>     sequenceGeneratorOptions =
+>          -- todo: could try to combine exclusive options
+>          -- such as cycle and nocycle
+>          permute ((\a b c d e f g h -> catMaybes [a,b,c,d,e,f,g,h])
+>                   <$?> (Nothing, Just <$> startWith)
+>                   <|?> (Nothing, Just <$> incrementBy)
+>                   <|?> (Nothing, Just <$> maxValue)
+>                   <|?> (Nothing, Just <$> noMaxValue)
+>                   <|?> (Nothing, Just <$> minValue)
+>                   <|?> (Nothing, Just <$> noMinValue)
+>                   <|?> (Nothing, Just <$> scycle)
+>                   <|?> (Nothing, Just <$> noCycle)
+>                  )
+>     startWith = keywords_ ["start", "with"] >>
+>                 SGOStartWith <$> signedInteger
+>     incrementBy = keywords_ ["increment", "by"] >>
+>                 SGOIncrementBy <$> signedInteger
+>     maxValue = keyword_ "maxvalue" >>
+>                 SGOMaxValue <$> signedInteger
+>     noMaxValue = SGONoMaxValue <$ try (keywords_ ["no","maxvalue"])
+>     minValue = keyword_ "minvalue" >>
+>                 SGOMinValue <$> signedInteger
+>     noMinValue = SGONoMinValue <$ try (keywords_ ["no","minvalue"])
+>     scycle = SGOCycle <$ keyword_ "cycle"
+>     noCycle = SGONoCycle <$ try (keywords_ ["no","cycle"])
+
+slightly hacky parser for signed integers
+
+> signedInteger :: Parser Integer
+> signedInteger = do
+>     s <- option 1 (1 <$ symbol "+" <|> (-1) <$ symbol "-")
+>     d <- unsignedInteger
+>     return $ s * d
 
 > dropSchema :: Parser Statement
 > dropSchema = keyword_ "schema" >>
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index 689a27d..6fdb1fd 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -453,12 +453,34 @@ which have been changed to try to improve the layout of the output.
 > statement _ (CreateSchema nm) =
 >     text "create" <+> text "schema" <+> names nm
 
-> statement _ (CreateTable nm cds) =
+> statement d (CreateTable nm cds) =
 >     text "create" <+> text "table" <+> names nm
 >     <+> parens (commaSep $ map cd cds)
 >   where
->     cd (ColumnDef n t) = name n <+> typeName t
-
+>     cd (ColumnDef n t mdef) =
+>       name n <+> typeName t
+>       <+> case mdef of
+>              Nothing -> empty
+>              Just (DefaultClause def) ->
+>                  text "default" <+> valueExpr d def
+>              Just (IdentityColumnSpec w o) ->
+>                  text "generated"
+>                  <+> (case w of
+>                          GeneratedDefault -> empty
+>                          GeneratedAlways -> text "always"
+>                          GeneratedByDefault -> text "by" <+> text "default")
+>                  <+> text "as" <+> text "identity"
+>                  <+> (case o of
+>                          [] -> empty
+>                          os -> parens (sep $ map sgo os))
+>     sgo (SGOStartWith i) = texts ["start",  "with", show i]
+>     sgo (SGOIncrementBy i) = texts ["increment", "by", show i]
+>     sgo (SGOMaxValue i) = texts ["maxvalue", show i]
+>     sgo SGONoMaxValue = texts ["no", "maxvalue"]
+>     sgo (SGOMinValue i) = texts ["minvalue", show i]
+>     sgo SGONoMinValue = texts ["no", "minvalue"]
+>     sgo SGOCycle = text "cycle"
+>     sgo SGONoCycle = text "no cycle"
 
 > statement _ (DropSchema nm db) =
 >     text "drop" <+> text "schema" <+> names nm <+> dropBehav db
@@ -521,3 +543,6 @@ which have been changed to try to improve the layout of the output.
 
 > comment :: Comment -> Doc
 > comment (BlockComment str) = text "/*" <+> text str <+> text "*/"
+
+> texts :: [String] -> Doc
+> texts ts = sep $ map text ts
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index 1b1df45..73b518c 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -36,7 +36,10 @@
 >     ,IdentityRestart(..)
 >     ,InsertSource(..)
 >     ,SetClause(..)
->     ,TableElement(..) 
+>     ,TableElement(..)
+>     ,DefaultClause(..)
+>     ,IdentityWhen(..)
+>     ,SequenceGeneratorOption(..)
 >      -- * Dialect
 >     ,Dialect(..)
 >      -- * Comment
@@ -489,7 +492,7 @@ I'm not sure if this is valid syntax or not.
 
 > data TableElement =
 >     ColumnDef Name TypeName
->        -- (Maybe DefaultClause)
+>        (Maybe DefaultClause)
 >        -- (Maybe ColumnConstraintDef)
 >        -- (Maybe CollateClause)
 >   --   | TableConstraintDef
@@ -498,10 +501,28 @@ I'm not sure if this is valid syntax or not.
 > {-data TableConstraintDef
 >     deriving (Eq,Show,Read,Data,Typeable) -}
 
-> {-data DefaultClause =
+> data DefaultClause =
 >      DefaultClause ValueExpr
->    | IdentityColumnSpec
->    | GenerationClause-}
+>    | IdentityColumnSpec IdentityWhen [SequenceGeneratorOption]
+>    --  | GenerationClause
+>     deriving (Eq,Show,Read,Data,Typeable)
+
+> data IdentityWhen =
+>     GeneratedDefault
+>   | GeneratedAlways
+>   | GeneratedByDefault
+>     deriving (Eq,Show,Read,Data,Typeable)
+
+> data SequenceGeneratorOption =
+>     SGOStartWith Integer
+>   | SGOIncrementBy Integer
+>   | SGOMaxValue Integer
+>   | SGONoMaxValue
+>   | SGOMinValue Integer
+>   | SGONoMinValue
+>   | SGOCycle
+>   | SGONoCycle
+>     deriving (Eq,Show,Read,Data,Typeable)
 
 > {-data ColumnConstraintDef =
 >     | NotNullConstraint
diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs b/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs
index aba17dd..eddd330 100644
--- a/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs
+++ b/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs
@@ -92,8 +92,8 @@ schema name can be quoted iden or unicode quoted iden
 
 >     ,(TestStatement SQL2011 "create table t (a int, b int);"
 >      $ CreateTable [Name "t"]
->        [ColumnDef (Name "a") (TypeName [Name "int"])
->        ,ColumnDef (Name "b") (TypeName [Name "int"])])
+>        [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing
+>        ,ColumnDef (Name "b") (TypeName [Name "int"]) Nothing])
 
 
 <table contents source> ::=
@@ -111,10 +111,14 @@ schema name can be quoted iden or unicode quoted iden
 <system versioning clause> ::=
   SYSTEM VERSIONING
 
+defintely skip
+
 <table commit action> ::=
     PRESERVE
   | DELETE
 
+defintely skip
+
 <table element list> ::=
   <left paren> <table element> [ { <comma> <table element> }... ] <right paren>
 
@@ -128,41 +132,63 @@ schema name can be quoted iden or unicode quoted iden
   OF <path-resolved user-defined type name> [ <subtable clause> ]
       [ <typed table element list> ]
 
+defintely skip
+
 <typed table element list> ::=
   <left paren> <typed table element>
       [ { <comma> <typed table element> }... ] <right paren>
 
+defintely skip
+
 <typed table element> ::=
     <column options>
   | <table constraint definition>
   | <self-referencing column specification>
 
+defintely skip
+
 <self-referencing column specification> ::=
   REF IS <self-referencing column name> [ <reference generation> ]
 
+defintely skip
+
 <reference generation> ::=
     SYSTEM GENERATED
   | USER GENERATED
   | DERIVED
 
+defintely skip
+
 <self-referencing column name> ::=
   <column name>
 
+defintely skip
+
 <column options> ::=
   <column name> WITH OPTIONS <column option list>
 
+defintely skip
+
 <column option list> ::=
   [ <scope clause> ] [ <default clause> ] [ <column constraint definition>... ]
 
+defintely skip
+
 <subtable clause> ::=
   UNDER <supertable clause>
 
+defintely skip
+
 <supertable clause> ::=
   <supertable name>
 
+defintely skip
+
 <supertable name> ::=
   <table name>
 
+defintely skip
+
 <like clause> ::=
   LIKE <table name> [ <like options> ]
 
@@ -198,25 +224,39 @@ schema name can be quoted iden or unicode quoted iden
   <system or application time period specification>
       <left paren> <period begin column name> <comma> <period end column name> <right paren>
 
+defintely skip
+
 <system or application time period specification> ::=
     <system time period specification>
   | <application time period specification>
 
+defintely skip
+
 <system time period specification> ::=
   PERIOD FOR SYSTEM_TIME
 
+defintely skip
+
 <application time period specification> ::=
   PERIOD FOR <application time period name>
 
+defintely skip
+
 <application time period name> ::=
   <identifier>
 
+defintely skip
+
 <period begin column name> ::=
   <column name>
 
+defintely skip
+
 <period end column name> ::=
   <column name>
 
+defintely skip
+
 
 11.4 <column definition>
 
@@ -235,12 +275,18 @@ schema name can be quoted iden or unicode quoted iden
 <system time period start column specification> ::=
   <timestamp generation rule> AS ROW START
 
+defintely skip
+
 <system time period end column specification> ::=
   <timestamp generation rule> AS ROW END
 
+defintely skip
+
 <timestamp generation rule> ::=
   GENERATED ALWAYS
 
+defintely skip
+
 <column constraint definition> ::=
   [ <constraint name definition> ] <column constraint> [ <constraint characteristics> ]
 
@@ -254,13 +300,50 @@ schema name can be quoted iden or unicode quoted iden
   GENERATED { ALWAYS | BY DEFAULT } AS IDENTITY
       [ <left paren> <common sequence generator options> <right paren> ]
 
-generated always as identity
-generated by default as identity
+>     ,(TestStatement SQL2011 "create table t (a int generated as identity);"
+>      $ CreateTable [Name "t"]
+>        [ColumnDef (Name "a") (TypeName [Name "int"])
+>         (Just $ IdentityColumnSpec GeneratedDefault [])])
 
-generated always as identity (start with signed_numeric
-                              increment by n
-                              maxvalue n | no maxvalue
-                              minvalue n | no minvalue)
+>     ,(TestStatement SQL2011 "create table t (a int generated always as identity);"
+>      $ CreateTable [Name "t"]
+>        [ColumnDef (Name "a") (TypeName [Name "int"])
+>         (Just $ IdentityColumnSpec GeneratedAlways [])])
+
+>     ,(TestStatement SQL2011 "create table t (a int generated by default as identity);"
+>      $ CreateTable [Name "t"]
+>        [ColumnDef (Name "a") (TypeName [Name "int"])
+>         (Just $ IdentityColumnSpec GeneratedByDefault [])])
+
+
+>     ,(TestStatement SQL2011
+>       "create table t (a int generated as identity\
+>       \  ( start with 5 increment by 5 maxvalue 500 minvalue 5 cycle ));"
+>      $ CreateTable [Name "t"]
+>        [ColumnDef (Name "a") (TypeName [Name "int"])
+>         (Just $ IdentityColumnSpec GeneratedDefault
+>          [SGOStartWith 5
+>          ,SGOIncrementBy 5
+>          ,SGOMaxValue 500
+>          ,SGOMinValue 5
+>          ,SGOCycle])])
+
+>     ,(TestStatement SQL2011
+>       "create table t (a int generated as identity\
+>       \  ( start with -4 no maxvalue no minvalue no cycle ));"
+>      $ CreateTable [Name "t"]
+>        [ColumnDef (Name "a") (TypeName [Name "int"])
+>         (Just $ IdentityColumnSpec GeneratedDefault
+>          [SGOStartWith (-4)
+>          ,SGONoMaxValue
+>          ,SGONoMinValue
+>          ,SGONoCycle])])
+
+I think <common sequence generator options> is supposed to just
+whitespace separated. In db2 it seems to be csv, but the grammar here
+just seems to be whitespace separated, and it is just whitespace
+separated in oracle... Not completely sure though. Usually db2 is
+closer than oracle?
 
 generated always (valueexpr)
 
@@ -293,6 +376,12 @@ generated always (valueexpr)
   | <implicitly typed value specification>
 
 
+>     ,(TestStatement SQL2011 "create table t (a int default 0);"
+>      $ CreateTable [Name "t"]
+>        [ColumnDef (Name "a") (TypeName [Name "int"])
+>         (Just $ DefaultClause $ NumLit "0")])
+
+
 
 11.6 <table constraint definition>
 
@@ -322,6 +411,9 @@ generated always (valueexpr)
 <without overlap specification> ::=
   <application time period name> WITHOUT OVERLAPS
 
+defintely skip
+
+
 11.8 <referential constraint definition>
 
 <referential constraint definition> ::=
@@ -344,6 +436,8 @@ generated always (valueexpr)
 <referencing period specification> ::=
   PERIOD <application time period name>
 
+defintely skip
+
 <referenced table and columns> ::=
   <table name> [ <left paren> <referenced column list>
       [ <comma> <referenced period specification> ] <right paren> ]
@@ -354,6 +448,8 @@ generated always (valueexpr)
 <referenced period specification> ::=
   PERIOD <application time period name>
 
+defintely skip
+
 <referential triggered action> ::=
     <update rule> [ <delete rule> ]
   | <delete rule> [ <update rule> ]
@@ -397,6 +493,10 @@ generated always (valueexpr)
 <add column definition> ::=
   ADD [ COLUMN ] <column definition>
 
+alter table t add column a int
+alter table t add a int
+alter table t add a int unique not null check (a>0)
+
 11.12 <alter column definition>
 
 <alter column definition> ::=
@@ -420,22 +520,30 @@ generated always (valueexpr)
 <set column default clause> ::=
   SET <default clause>
 
+alter table t alter column c set default ...
+alter table t alter c set default ...
+
 11.14 <drop column default clause>
 
 <drop column default clause> ::=
   DROP DEFAULT
 
+alter table t alter column c drop default
 
 11.15 <set column not null clause>
 
 <set column not null clause> ::=
   SET NOT NULL
 
+alter table t alter column c set not null
+
 11.16 <drop column not null clause>
 
 <drop column not null clause> ::=
   DROP NOT NULL
 
+alter table t alter column c drop not null
+
 11.17 <add column scope clause>
 
 <add column scope clause> ::=
@@ -451,6 +559,8 @@ generated always (valueexpr)
 <alter column data type clause> ::=
   SET DATA TYPE <data type>
 
+alter table t alter column c set data type int;
+
 11.20 <alter identity column specification>
 
 <alter identity column specification> ::=
@@ -460,73 +570,116 @@ generated always (valueexpr)
 <set identity column generation clause> ::=
   SET GENERATED { ALWAYS | BY DEFAULT }
 
+alter table t alter column c set generated always
+
+alter table t alter column c set generated by default
+
 <alter identity column option> ::=
     <alter sequence generator restart option>
   | SET <basic sequence generator option>
 
+alter table t alter column c restart
+alter table t alter column c restart with 4 (snl)
+
+alter table t alter column c set increment by minvalue maxvalue cycle
+
+
 11.21 <drop identity property clause>
 
 <drop identity property clause> ::=
   DROP IDENTITY
 
+alter table t alter column c drop identity
+
 11.22 <drop column generation expression clause>
 
 <drop column generation expression clause> ::=
   DROP EXPRESSION
 
+alter table t alter column c drop expression
+
 11.23 <drop column definition>
 
 <drop column definition> ::=
   DROP [ COLUMN ] <column name> <drop behavior>
 
+alter table t alter drop column c
+
+alter table t alter drop c restrict
+alter table t alter drop c cascade
+
 11.24 <add table constraint definition>
 
 <add table constraint definition> ::=
   ADD <table constraint definition>
 
+todo
+
 11.25 <alter table constraint definition>
 <alter table constraint definition> ::=
   ALTER CONSTRAINT <constraint name> <constraint enforcement>
 
+todo
+
 11.26 <drop table constraint definition>
 
 <drop table constraint definition> ::=
   DROP CONSTRAINT <constraint name> <drop behavior>
 
+todo
+
 11.27 <add table period definition>
 
 <add table period definition> ::=
   ADD <table period definition> [ <add system time period column list> ]
 
+defintely skip
+
 <add system time period column list> ::=
   ADD [ COLUMN ] <column definition 1> ADD [ COLUMN ] <column definition 2>
 
+defintely skip
+
 <column definition 1> ::=
   <column definition>
 
+defintely skip
+
 <column definition 2> ::=
   <column definition>
 
+defintely skip
+
 11.28 <drop table period definition>
 
 <drop table period definition> ::=
   DROP <system or application time period specification> <drop behavior>
 
+defintely skip
+
 11.29 <add system versioning clause>
 
 <add system versioning clause> ::=
   ADD <system versioning clause>
 
+defintely skip
+
 11.30 <drop system versioning clause>
 
 <drop system versioning clause> ::=
   DROP SYSTEM VERSIONING <drop behavior>
 
+defintely skip
+
 11.31 <drop table statement>
 
 <drop table statement> ::=
   DROP TABLE <table name> <drop behavior>
 
+drop table t
+drop table t cascade
+drop table t restrict
+
 11.32 <view definition>
 
 <view definition> ::=