add create,alter,drop sequence

2015-08-04 22:35:51 +03:00 · 2015-08-04 22:35:51 +03:00 · a9d51d1ebb
parent 9aab04b189
commit a9d51d1ebb
4 changed files with 151 additions and 49 deletions
--- 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
--- 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
--- 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
--- 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)
+
+
 >     ]