From a9d51d1ebb700712a54743e42d6fa25531933418 Mon Sep 17 00:00:00 2001 From: Jake Wheat 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 ::= @@ -1983,9 +2004,35 @@ defintely skip ::= +> ,(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 +> ,(TestStatement SQL2011 +> "drop sequence seq" +> $ DropSequence [Name "seq"] DefaultDropBehaviour) + +> ,(TestStatement SQL2011 +> "drop sequence seq restrict" +> $ DropSequence [Name "seq"] Restrict) + + > ]