From a9d51d1ebb700712a54743e42d6fa25531933418 Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Tue, 4 Aug 2015 22:35:51 +0300
Subject: [PATCH] add create,alter,drop sequence

---
 Language/SQL/SimpleSQL/Parser.lhs             | 88 +++++++++++++------
 Language/SQL/SimpleSQL/Pretty.lhs             | 43 ++++++---
 Language/SQL/SimpleSQL/Syntax.lhs             | 22 +++--
 .../Language/SQL/SimpleSQL/SQL2011Schema.lhs  | 47 ++++++++++
 4 files changed, 151 insertions(+), 49 deletions(-)

diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index af1c03d..2d37a1b 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -1444,13 +1444,16 @@ TODO: change style
 >     [keyword_ "create" *> choice [createSchema
 >                                  ,createTable
 >                                  ,createView
->                                  ,createDomain]
+>                                  ,createDomain
+>                                  ,createSequence]
 >     ,keyword_ "alter" *> choice [alterTable
->                                 ,alterDomain]
+>                                 ,alterDomain
+>                                 ,alterSequence]
 >     ,keyword_ "drop" *> choice [dropSchema
 >                                ,dropTable
 >                                ,dropView
->                                ,dropDomain]
+>                                ,dropDomain
+>                                ,dropSequence]
 >     ,delete
 >     ,truncateSt
 >     ,insert
@@ -1488,31 +1491,6 @@ TODO: change style
 >         <*> (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"])
 
 > tableConstraintDef :: Parser (Maybe [Name], TableConstraint)
 > tableConstraintDef =
@@ -1578,6 +1556,44 @@ slightly hacky parser for signed integers
 >     (*) <$> option 1 (1 <$ symbol "+" <|> (-1) <$ symbol "-")
 >     <*> unsignedInteger
 
+> sequenceGeneratorOptions :: Parser [SequenceGeneratorOption]
+> sequenceGeneratorOptions =
+>          -- todo: could try to combine exclusive options
+>          -- such as cycle and nocycle
+>          -- sort out options which are sometimes not allowed
+>          -- as datatype, and restart with
+>     permute ((\a b c d e f g h j k -> catMaybes [a,b,c,d,e,f,g,h,j,k])
+>                   <$?> nj startWith
+>                   <|?> nj dataType
+>                   <|?> nj restart
+>                   <|?> nj incrementBy
+>                   <|?> nj maxValue
+>                   <|?> nj noMaxValue
+>                   <|?> nj minValue
+>                   <|?> nj noMinValue
+>                   <|?> nj scycle
+>                   <|?> nj noCycle
+>                  )
+>   where
+>     nj p = (Nothing,Just <$> p)
+>     startWith = keywords_ ["start", "with"] >>
+>                 SGOStartWith <$> signedInteger
+>     dataType = keyword_ "as" >>
+>                SGODataType <$> typeName
+>     restart = keyword_ "restart" >>
+>               SGORestart <$> optionMaybe (keyword_ "with" *> 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"])
+
+
 > alterTable :: Parser Statement
 > alterTable = keyword_ "table" >>
 >     -- the choices have been ordered so that it works
@@ -1671,6 +1687,22 @@ slightly hacky parser for signed integers
 > dropDomain = keyword_ "domain" >>
 >     DropDomain <$> names <*> dropBehaviour
 
+> createSequence :: Parser Statement
+> createSequence = keyword_ "sequence" >>
+>     CreateSequence
+>     <$> names
+>     <*> sequenceGeneratorOptions
+
+> alterSequence :: Parser Statement
+> alterSequence = keyword_ "sequence" >>
+>     AlterSequence
+>     <$> names
+>     <*> sequenceGeneratorOptions
+
+> dropSequence :: Parser Statement
+> dropSequence = keyword_ "sequence" >>
+>     DropSequence <$> names <*> dropBehaviour
+
 -----------------
 
 = dml
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index 5f78cae..6bed655 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -486,17 +486,28 @@ which have been changed to try to improve the layout of the output.
 >   where
 >     a (ADSetDefault v) = texts ["set","default"] <+> valueExpr d v
 >     a (ADDropDefault) = texts ["drop","default"]
->     a (ADAddConstraint nm e) =
+>     a (ADAddConstraint cnm e) =
 >         text "add"
->         <+> maybe empty (\nm' -> text "constraint" <+> names nm') nm
+>         <+> maybe empty (\cnm' -> text "constraint" <+> names cnm') cnm
 >         <+> text "check" <> parens (valueExpr d e)
->     a (ADDropConstraint nm) = texts ["drop", "constraint"]
->                               <+> names nm
+>     a (ADDropConstraint cnm) = texts ["drop", "constraint"]
+>                                <+> names cnm
 
 
 > statement _ (DropDomain nm db) =
 >     text "drop" <+> text "domain" <+> names nm <+> dropBehav db
 
+> statement _ (CreateSequence nm sgos) =
+>   texts ["create","sequence"] <+> names nm
+>   <+> sep (map sequenceGeneratorOption sgos)
+
+> statement _ (AlterSequence nm sgos) =
+>   texts ["alter","sequence"] <+> names nm
+>   <+> sep (map sequenceGeneratorOption sgos)
+
+> statement _ (DropSequence nm db) =
+>     text "drop" <+> text "sequence" <+> names nm <+> dropBehav db
+
 == dml
 
 > statement d (SelectStatement q) = queryExpr d q
@@ -581,17 +592,9 @@ which have been changed to try to improve the layout of the output.
 >                  <+> text "as" <+> text "identity"
 >                  <+> (case o of
 >                          [] -> empty
->                          os -> parens (sep $ map sgo os))
+>                          os -> parens (sep $ map sequenceGeneratorOption os))
 >       <+> sep (map cdef cons)
 >   where
->     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"
 >     cdef (ColConstraintDef cnm con) =
 >         maybe empty (\s -> text "constraint" <+> names s) cnm
 >         <+> pcon con
@@ -607,6 +610,20 @@ which have been changed to try to improve the layout of the output.
 >         <+> refAct "update" u
 >         <+> refAct "delete" del
 
+> sequenceGeneratorOption :: SequenceGeneratorOption -> Doc
+> sequenceGeneratorOption (SGODataType t) =
+>     text "as" <+> typeName t
+> sequenceGeneratorOption (SGORestart mi) =
+>     text "restart" <+> maybe empty (\mi' -> texts ["with", show mi']) mi
+> sequenceGeneratorOption (SGOStartWith i) = texts ["start",  "with", show i]
+> sequenceGeneratorOption (SGOIncrementBy i) = texts ["increment", "by", show i]
+> sequenceGeneratorOption (SGOMaxValue i) = texts ["maxvalue", show i]
+> sequenceGeneratorOption SGONoMaxValue = texts ["no", "maxvalue"]
+> sequenceGeneratorOption (SGOMinValue i) = texts ["minvalue", show i]
+> sequenceGeneratorOption SGONoMinValue = texts ["no", "minvalue"]
+> sequenceGeneratorOption SGOCycle = text "cycle"
+> sequenceGeneratorOption SGONoCycle = text "no cycle"
+
 > refMatch :: ReferenceMatch -> Doc
 > refMatch m = case m of
 >                      DefaultReferenceMatch -> empty
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index 902add0..cbdbcaa 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -415,28 +415,32 @@ I'm not sure if this is valid syntax or not.
 >        [(Maybe [Name], ValueExpr)]
 >   | AlterDomain [Name] AlterDomainAction
 >   | DropDomain [Name] DropBehaviour
+
+>     -- probably won't do character sets, collations
+>     -- and translations because I think they are too far from
+>     -- reality
 >   {- | CreateCharacterSet
 >   | DropCharacterSet
 >   | CreateCollation
 >   | DropCollation
 >   | CreateTranslation
->   | DropTranslation
->   | CreateAssertion
+>   | DropTranslation -}
+>   {-  | CreateAssertion
 >   | DropAssertion
 >   | CreateTrigger
 >   | DropTrigger
 >   | CreateType
 >   | AlterType
 >   | DropType
->     -- routine stuff?
+>     -- routine stuff? TODO
 >   | CreateCast
 >   | DropCast
 >   | CreateOrdering
->   | DropOrdering
+>   | DropOrdering -}
 >     -- transforms
->   | CreateSequence
->   | AlterSequence
->   | DropSequence -}
+>   | CreateSequence [Name] [SequenceGeneratorOption]
+>   | AlterSequence [Name] [SequenceGeneratorOption]
+>   | DropSequence [Name] DropBehaviour
 >     -- dml
 >   | SelectStatement QueryExpr
 >   {-    | DeclareCursor
@@ -611,7 +615,9 @@ I'm not sure if this is valid syntax or not.
 >     deriving (Eq,Show,Read,Data,Typeable)
 
 > data SequenceGeneratorOption =
->     SGOStartWith Integer
+>     SGODataType TypeName
+>   | SGOStartWith Integer
+>   | SGORestart (Maybe Integer)
 >   | SGOIncrementBy Integer
 >   | SGOMaxValue Integer
 >   | SGONoMaxValue
diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs b/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs
index b38ba75..eb11f35 100644
--- a/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs
+++ b/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs
@@ -890,6 +890,10 @@ is there no way to do this:
 alter table t alter column c set generated as (a * 3)
 ??
 
+UPDATE: alter sequence uses same syntax as create sequence, which is
+the same sytnax as identity in create table, so overrule the sql
+standard and use the same syntax in alter identity.
+
 PLAN: TODO
 
 don't implement alter table alter column generated now
@@ -1965,6 +1969,23 @@ defintely skip
     CYCLE
   | NO CYCLE
 
+>     ,(TestStatement SQL2011
+>       "create sequence seq"
+>      $ CreateSequence [Name "seq"] [])
+
+>     ,(TestStatement SQL2011
+>       "create sequence seq as bigint"
+>      $ CreateSequence [Name "seq"]
+>         [SGODataType $ TypeName [Name "bigint"]])
+
+>     ,(TestStatement SQL2011
+>       "create sequence seq as bigint start with 5"
+>      $ CreateSequence [Name "seq"]
+>         [SGOStartWith 5
+>         ,SGODataType $ TypeName [Name "bigint"]
+>         ])
+
+
 11.73 <alter sequence generator statement>
 
 <alter sequence generator statement> ::=
@@ -1983,9 +2004,35 @@ defintely skip
 <sequence generator restart value> ::=
   <signed numeric literal>
 
+>     ,(TestStatement SQL2011
+>       "alter sequence seq restart"
+>      $ AlterSequence [Name "seq"]
+>         [SGORestart Nothing])
+
+>     ,(TestStatement SQL2011
+>       "alter sequence seq restart with 5"
+>      $ AlterSequence [Name "seq"]
+>         [SGORestart $ Just 5])
+
+>     ,(TestStatement SQL2011
+>       "alter sequence seq restart with 5 increment by 5"
+>      $ AlterSequence [Name "seq"]
+>         [SGORestart $ Just 5
+>         ,SGOIncrementBy 5])
+
+
 11.74 <drop sequence generator statement>
 
 <drop sequence generator statement> ::=
   DROP SEQUENCE <sequence generator name> <drop behavior>
 
+>     ,(TestStatement SQL2011
+>       "drop sequence seq"
+>      $ DropSequence [Name "seq"] DefaultDropBehaviour)
+
+>     ,(TestStatement SQL2011
+>       "drop sequence seq restrict"
+>      $ DropSequence [Name "seq"] Restrict)
+
+
 >     ]