From fa1df4c7a2f2310d07a94247d72492dec07d599b Mon Sep 17 00:00:00 2001 From: Jake Wheat Date: Sun, 2 Aug 2015 20:36:05 +0300 Subject: [PATCH] add table constraint definitions to create table --- Language/SQL/SimpleSQL/Parser.lhs | 60 ++++--- Language/SQL/SimpleSQL/Pretty.lhs | 64 +++++--- Language/SQL/SimpleSQL/Syntax.lhs | 36 +++-- .../Language/SQL/SimpleSQL/SQL2011Schema.lhs | 147 +++++++++++++++--- 4 files changed, 230 insertions(+), 77 deletions(-) diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs index d3960b9..8ca9e01 100644 --- a/Language/SQL/SimpleSQL/Parser.lhs +++ b/Language/SQL/SimpleSQL/Parser.lhs @@ -1466,11 +1466,11 @@ TODO: change style > CreateTable > <$> names > -- todo: is this order mandatory or is it a perm? -> <*> parens (commaSep1 columnDef) +> <*> parens (commaSep1 (tableConstraintDef <|> columnDef)) > where > columnDef = ColumnDef <$> name <*> typeName > <*> optionMaybe defaultClause -> <*> option [] (many1 constraintDef) +> <*> option [] (many1 colConstraintDef) > defaultClause = choice [ > keyword_ "default" >> > DefaultClause <$> valueExpr @@ -1511,28 +1511,35 @@ TODO: change style > scycle = SGOCycle <$ keyword_ "cycle" > noCycle = SGONoCycle <$ try (keywords_ ["no","cycle"]) - -> constraintDef :: Parser ConstraintDef -> constraintDef = -> ConstraintDef +> tableConstraintDef :: Parser TableElement +> tableConstraintDef = +> TableConstraintDef > <$> (optionMaybe (keyword_ "constraint" *> names)) -> <*> (notNull <|> unique <|> primaryKey <|> check <|> references) +> <*> (unique <|> primaryKey <|> check <|> references) > where -> notNull = NotNullConstraint <$ keywords_ ["not", "null"] -> unique = UniqueConstraint <$ keyword_ "unique" -> primaryKey = PrimaryKeyConstraint <$ keywords_ ["primary", "key"] -> check = keyword_ "check" >> CheckConstraint <$> parens valueExpr -> references = keyword_ "references" >> -> (\t c m (ou,od) -> ReferencesConstraint t c m ou od) -> <$> names -> <*> optionMaybe (parens name) -> <*> option DefaultReferenceMatch +> unique = keyword_ "unique" >> +> TableUniqueConstraint <$> parens (commaSep1 name) +> primaryKey = keywords_ ["primary", "key"] >> +> TablePrimaryKeyConstraint <$> parens (commaSep1 name) +> check = keyword_ "check" >> TableCheckConstraint <$> parens valueExpr +> references = keywords_ ["foreign", "key"] >> +> (\cs ft ftcs m (u,d) -> TableReferencesConstraint cs ft ftcs m u d) +> <$> parens (commaSep1 name) +> <*> (keyword_ "references" *> names) +> <*> optionMaybe (parens $ commaSep1 name) +> <*> refMatch +> <*> refActions + +> refMatch :: Parser ReferenceMatch +> refMatch = option DefaultReferenceMatch > (keyword_ "match" *> > choice [MatchFull <$ keyword_ "full" > ,MatchPartial <$ keyword_ "partial" > ,MatchSimple <$ keyword_ "simple"]) -> <*> permute ((,) <$?> (DefaultReferentialAction, onUpdate) -> <|?> (DefaultReferentialAction, onDelete)) +> refActions :: Parser (ReferentialAction,ReferentialAction) +> refActions = permute ((,) <$?> (DefaultReferentialAction, onUpdate) +> <|?> (DefaultReferentialAction, onDelete)) +> where > -- todo: left factor? > onUpdate = try (keywords_ ["on", "update"]) *> referentialAction > onDelete = try (keywords_ ["on", "delete"]) *> referentialAction @@ -1544,6 +1551,23 @@ TODO: change style > ,RefRestrict <$ keyword_ "restrict" > ,RefNoAction <$ keywords_ ["no", "action"]] +> colConstraintDef :: Parser ColConstraintDef +> colConstraintDef = +> ColConstraintDef +> <$> (optionMaybe (keyword_ "constraint" *> names)) +> <*> (notNull <|> unique <|> primaryKey <|> check <|> references) +> where +> notNull = ColNotNullConstraint <$ keywords_ ["not", "null"] +> unique = ColUniqueConstraint <$ keyword_ "unique" +> primaryKey = ColPrimaryKeyConstraint <$ keywords_ ["primary", "key"] +> check = keyword_ "check" >> ColCheckConstraint <$> parens valueExpr +> references = keyword_ "references" >> +> (\t c m (ou,od) -> ColReferencesConstraint t c m ou od) +> <$> names +> <*> optionMaybe (parens name) +> <*> refMatch +> <*> refActions + slightly hacky parser for signed integers > signedInteger :: Parser Integer diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 0681fe2..12fd8df 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/Language/SQL/SimpleSQL/Pretty.lhs @@ -476,6 +476,24 @@ which have been changed to try to improve the layout of the output. > [] -> empty > os -> parens (sep $ map sgo os)) > <+> sep (map cdef cons) +> cd (TableConstraintDef n con) = +> maybe empty (\s -> text "constraint" <+> names s) n +> <+> ptcon con +> ptcon (TableUniqueConstraint ns) = +> text "unique" <+> parens (commaSep $ map name ns) +> ptcon (TablePrimaryKeyConstraint ns) = +> texts ["primary","key"] <+> parens (commaSep $ map name ns) +> ptcon (TableReferencesConstraint cs t tcs m u del) = +> texts ["foreign", "key"] +> <+> parens (commaSep $ map name cs) +> <+> text "references" +> <+> names t +> <+> maybe empty (\c' -> parens (commaSep $ map name c')) tcs +> <+> refMatch m +> <+> refAct "update" u +> <+> refAct "delete" del +> ptcon (TableCheckConstraint v) = text "check" <+> parens (valueExpr d v) + > sgo (SGOStartWith i) = texts ["start", "with", show i] > sgo (SGOIncrementBy i) = texts ["increment", "by", show i] > sgo (SGOMaxValue i) = texts ["maxvalue", show i] @@ -484,36 +502,32 @@ which have been changed to try to improve the layout of the output. > sgo SGONoMinValue = texts ["no", "minvalue"] > sgo SGOCycle = text "cycle" > sgo SGONoCycle = text "no cycle" -> cdef (ConstraintDef cnm con) = +> cdef (ColConstraintDef cnm con) = > maybe empty (\s -> text "constraint" <+> names s) cnm > <+> pcon con -> pcon NotNullConstraint = texts ["not","null"] -> pcon UniqueConstraint = text "unique" -> pcon PrimaryKeyConstraint = texts ["primary","key"] -> pcon (CheckConstraint v) = text "check" <+> parens (valueExpr d v) -> pcon (ReferencesConstraint t c m u del) = +> pcon ColNotNullConstraint = texts ["not","null"] +> pcon ColUniqueConstraint = text "unique" +> pcon ColPrimaryKeyConstraint = texts ["primary","key"] +> pcon (ColCheckConstraint v) = text "check" <+> parens (valueExpr d v) +> pcon (ColReferencesConstraint t c m u del) = > text "references" > <+> names t > <+> maybe empty (\c' -> parens (name c')) c -> <+> (case m of -> DefaultReferenceMatch -> empty -> MatchFull -> texts ["match", "full"] -> MatchPartial -> texts ["match","partial"] -> MatchSimple -> texts ["match", "simple"]) -> <+> (case u of -> DefaultReferentialAction -> empty -> RefCascade -> texts ["on", "update", "cascade"] -> RefSetNull -> texts ["on", "update", "set", "null"] -> RefSetDefault -> texts ["on", "update", "set", "default"] -> RefRestrict -> texts ["on", "update", "restrict"] -> RefNoAction -> texts ["on", "update", "no", "action"]) -> <+> (case del of -> DefaultReferentialAction -> empty -> RefCascade -> texts ["on", "delete", "cascade"] -> RefSetNull -> texts ["on", "delete", "set", "null"] -> RefSetDefault -> texts ["on", "delete", "set", "default"] -> RefRestrict -> texts ["on", "delete", "restrict"] -> RefNoAction -> texts ["on", "delete", "no", "action"]) +> <+> refMatch m +> <+> refAct "update" u +> <+> refAct "delete" del +> refMatch m = case m of +> DefaultReferenceMatch -> empty +> MatchFull -> texts ["match", "full"] +> MatchPartial -> texts ["match","partial"] +> MatchSimple -> texts ["match", "simple"] +> refAct t a = case a of +> DefaultReferentialAction -> empty +> RefCascade -> texts ["on", t, "cascade"] +> RefSetNull -> texts ["on", t, "set", "null"] +> RefSetDefault -> texts ["on", t, "set", "default"] +> RefRestrict -> texts ["on", t, "restrict"] +> RefNoAction -> texts ["on", t, "no", "action"] > statement _ (DropSchema nm db) = > text "drop" <+> text "schema" <+> names nm <+> dropBehav db diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index bbefad7..303c1d8 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/Language/SQL/SimpleSQL/Syntax.lhs @@ -40,8 +40,9 @@ > ,DefaultClause(..) > ,IdentityWhen(..) > ,SequenceGeneratorOption(..) -> ,ConstraintDef(..) -> ,Constraint(..) +> ,ColConstraintDef(..) +> ,ColConstraint(..) +> ,TableConstraint(..) > ,ReferenceMatch(..) > ,ReferentialAction(..) > -- * Dialect @@ -497,27 +498,38 @@ I'm not sure if this is valid syntax or not. > data TableElement = > ColumnDef Name TypeName > (Maybe DefaultClause) -> [ConstraintDef] +> [ColConstraintDef] > -- (Maybe CollateClause) -> -- | TableConstraintDef +> | TableConstraintDef (Maybe [Name]) TableConstraint > deriving (Eq,Show,Read,Data,Typeable) -> data ConstraintDef = -> ConstraintDef (Maybe [Name]) Constraint +> data ColConstraintDef = +> ColConstraintDef (Maybe [Name]) ColConstraint > -- (Maybe [ConstraintCharacteristics]) > deriving (Eq,Show,Read,Data,Typeable) -> data Constraint = -> NotNullConstraint -> | UniqueConstraint -> | PrimaryKeyConstraint -> | ReferencesConstraint [Name] (Maybe Name) +> data ColConstraint = +> ColNotNullConstraint +> | ColUniqueConstraint +> | ColPrimaryKeyConstraint +> | ColReferencesConstraint [Name] (Maybe Name) > ReferenceMatch > ReferentialAction > ReferentialAction -> | CheckConstraint ValueExpr +> | ColCheckConstraint ValueExpr > deriving (Eq,Show,Read,Data,Typeable) +> data TableConstraint = +> TableUniqueConstraint [Name] +> | TablePrimaryKeyConstraint [Name] +> | TableReferencesConstraint [Name] [Name] (Maybe [Name]) +> ReferenceMatch +> ReferentialAction +> ReferentialAction +> | TableCheckConstraint ValueExpr +> deriving (Eq,Show,Read,Data,Typeable) + + > data ReferenceMatch = > DefaultReferenceMatch > | MatchFull diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs b/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs index bbe668c..1218315 100644 --- a/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs +++ b/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs @@ -25,6 +25,10 @@ This module covers the tests for parsing schema and DDL statements. todo: schema name can have . schema name can be quoted iden or unicode quoted iden +add schema element support: + create a list of schema elements + then do pairwise combinations in schema element list to test + ::= @@ -310,25 +314,25 @@ todo: constraint characteristics > "create table t (a int not null);" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing -> [ConstraintDef Nothing NotNullConstraint]]) +> [ColConstraintDef Nothing ColNotNullConstraint]]) > ,(TestStatement SQL2011 > "create table t (a int constraint a_not_null not null);" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing -> [ConstraintDef (Just [Name "a_not_null"]) NotNullConstraint]]) +> [ColConstraintDef (Just [Name "a_not_null"]) ColNotNullConstraint]]) > ,(TestStatement SQL2011 > "create table t (a int unique);" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing -> [ConstraintDef Nothing UniqueConstraint]]) +> [ColConstraintDef Nothing ColUniqueConstraint]]) > ,(TestStatement SQL2011 > "create table t (a int primary key);" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing -> [ConstraintDef Nothing PrimaryKeyConstraint]]) +> [ColConstraintDef Nothing ColPrimaryKeyConstraint]]) references t(a,b) [ Full |partial| simepl] @@ -339,7 +343,7 @@ references t(a,b) > "create table t (a int references u);" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing -> [ConstraintDef Nothing $ ReferencesConstraint +> [ColConstraintDef Nothing $ ColReferencesConstraint > [Name "u"] Nothing DefaultReferenceMatch > DefaultReferentialAction DefaultReferentialAction]]) @@ -347,7 +351,7 @@ references t(a,b) > "create table t (a int references u(a));" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing -> [ConstraintDef Nothing $ ReferencesConstraint +> [ColConstraintDef Nothing $ ColReferencesConstraint > [Name "u"] (Just $ Name "a") DefaultReferenceMatch > DefaultReferentialAction DefaultReferentialAction]]) @@ -355,7 +359,7 @@ references t(a,b) > "create table t (a int references u match full);" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing -> [ConstraintDef Nothing $ ReferencesConstraint +> [ColConstraintDef Nothing $ ColReferencesConstraint > [Name "u"] Nothing MatchFull > DefaultReferentialAction DefaultReferentialAction]]) @@ -363,7 +367,7 @@ references t(a,b) > "create table t (a int references u match partial);" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing -> [ConstraintDef Nothing $ ReferencesConstraint +> [ColConstraintDef Nothing $ ColReferencesConstraint > [Name "u"] Nothing MatchPartial > DefaultReferentialAction DefaultReferentialAction]]) @@ -371,7 +375,7 @@ references t(a,b) > "create table t (a int references u match simple);" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing -> [ConstraintDef Nothing $ ReferencesConstraint +> [ColConstraintDef Nothing $ ColReferencesConstraint > [Name "u"] Nothing MatchSimple > DefaultReferentialAction DefaultReferentialAction]]) @@ -379,7 +383,7 @@ references t(a,b) > "create table t (a int references u on update cascade );" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing -> [ConstraintDef Nothing $ ReferencesConstraint +> [ColConstraintDef Nothing $ ColReferencesConstraint > [Name "u"] Nothing DefaultReferenceMatch > RefCascade DefaultReferentialAction]]) @@ -387,7 +391,7 @@ references t(a,b) > "create table t (a int references u on update set null );" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing -> [ConstraintDef Nothing $ ReferencesConstraint +> [ColConstraintDef Nothing $ ColReferencesConstraint > [Name "u"] Nothing DefaultReferenceMatch > RefSetNull DefaultReferentialAction]]) @@ -395,7 +399,7 @@ references t(a,b) > "create table t (a int references u on update set default );" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing -> [ConstraintDef Nothing $ ReferencesConstraint +> [ColConstraintDef Nothing $ ColReferencesConstraint > [Name "u"] Nothing DefaultReferenceMatch > RefSetDefault DefaultReferentialAction]]) @@ -403,7 +407,7 @@ references t(a,b) > "create table t (a int references u on update no action );" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing -> [ConstraintDef Nothing $ ReferencesConstraint +> [ColConstraintDef Nothing $ ColReferencesConstraint > [Name "u"] Nothing DefaultReferenceMatch > RefNoAction DefaultReferentialAction]]) @@ -411,7 +415,7 @@ references t(a,b) > "create table t (a int references u on delete cascade );" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing -> [ConstraintDef Nothing $ ReferencesConstraint +> [ColConstraintDef Nothing $ ColReferencesConstraint > [Name "u"] Nothing DefaultReferenceMatch > DefaultReferentialAction RefCascade]]) @@ -420,7 +424,7 @@ references t(a,b) > "create table t (a int references u on update cascade on delete restrict );" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing -> [ConstraintDef Nothing $ ReferencesConstraint +> [ColConstraintDef Nothing $ ColReferencesConstraint > [Name "u"] Nothing DefaultReferenceMatch > RefCascade RefRestrict]]) @@ -428,19 +432,22 @@ references t(a,b) > "create table t (a int references u on delete restrict on update cascade );" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing -> [ConstraintDef Nothing $ ReferencesConstraint +> [ColConstraintDef Nothing $ ColReferencesConstraint > [Name "u"] Nothing DefaultReferenceMatch > RefCascade RefRestrict]]) +TODO: try combinations and permutations of column constraints and +options + + > ,(TestStatement SQL2011 > "create table t (a int check (a>5));" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing -> [ConstraintDef Nothing -> (CheckConstraint $ BinOp (Iden [Name "a"]) [Name ">"] (NumLit "5"))]]) +> [ColConstraintDef Nothing +> (ColCheckConstraint $ BinOp (Iden [Name "a"]) [Name ">"] (NumLit "5"))]]) -check (valueexpr) @@ -465,7 +472,7 @@ check (valueexpr) > ,(TestStatement SQL2011 -> "create table t (a int generated as identity\ +> "create table t (a int generated as identity\n\ > \ ( start with 5 increment by 5 maxvalue 500 minvalue 5 cycle ));" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) @@ -477,7 +484,7 @@ check (valueexpr) > ,SGOCycle]) []]) > ,(TestStatement SQL2011 -> "create table t (a int generated as identity\ +> "create table t (a int generated as identity\n\ > \ ( start with -4 no maxvalue no minvalue no cycle ));" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) @@ -505,7 +512,7 @@ generated always (valueexpr) > ,(TestStatement SQL2011 -> "create table t (a int, \ +> "create table t (a int, \n\ > \ a2 int generated always as (a * 2));" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] @@ -566,6 +573,42 @@ generated always (valueexpr) ::= +> ,(TestStatement SQL2011 +> "create table t (a int, unique (a));" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] +> ,TableConstraintDef Nothing $ TableUniqueConstraint [Name "a"] +> ]) + +> ,(TestStatement SQL2011 +> "create table t (a int, constraint a_unique unique (a));" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] +> ,TableConstraintDef (Just [Name "a_unique"]) $ +> TableUniqueConstraint [Name "a"] +> ]) + +todo: test permutations of column defs and table constraints + +> ,(TestStatement SQL2011 +> "create table t (a int, b int, unique (a,b));" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] +> ,ColumnDef (Name "b") (TypeName [Name "int"]) Nothing [] +> ,TableConstraintDef Nothing $ +> TableUniqueConstraint [Name "a", Name "b"] +> ]) + +> ,(TestStatement SQL2011 +> "create table t (a int, b int, primary key (a,b));" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] +> ,ColumnDef (Name "b") (TypeName [Name "int"]) Nothing [] +> ,TableConstraintDef Nothing $ +> TablePrimaryKeyConstraint [Name "a", Name "b"] +> ]) + + ::= WITHOUT OVERLAPS @@ -579,6 +622,36 @@ defintely skip [ ] + +> ,(TestStatement SQL2011 +> "create table t (a int, b int,\n\ +> \ foreign key (a,b) references u(c,d) match full on update cascade on delete restrict );" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] +> ,ColumnDef (Name "b") (TypeName [Name "int"]) Nothing [] +> ,TableConstraintDef Nothing $ +> TableReferencesConstraint +> [Name "a", Name "b"] +> [Name "u"] +> (Just [Name "c", Name "d"]) +> MatchFull RefCascade RefRestrict +> ]) + +> ,(TestStatement SQL2011 +> "create table t (a int,\n\ +> \ constraint tfku1 foreign key (a) references u);" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] +> ,TableConstraintDef (Just [Name "tfku1"]) $ +> TableReferencesConstraint +> [Name "a"] +> [Name "u"] +> Nothing DefaultReferenceMatch +> DefaultReferentialAction DefaultReferentialAction +> ]) + + + ::= REFERENCES [ MATCH ] [ ] @@ -625,10 +698,40 @@ defintely skip | RESTRICT | NO ACTION + + 11.9 ::= CHECK + +> ,(TestStatement SQL2011 +> "create table t (a int, b int, \n\ +> \ check (a > b));" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] +> ,ColumnDef (Name "b") (TypeName [Name "int"]) Nothing [] +> ,TableConstraintDef Nothing $ +> TableCheckConstraint +> (BinOp (Iden [Name "a"]) [Name ">"] (Iden [Name "b"])) +> ]) + + +> ,(TestStatement SQL2011 +> "create table t (a int, b int, \n\ +> \ constraint agtb check (a > b));" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] +> ,ColumnDef (Name "b") (TypeName [Name "int"]) Nothing [] +> ,TableConstraintDef (Just [Name "agtb"]) $ +> TableCheckConstraint +> (BinOp (Iden [Name "a"]) [Name ">"] (Iden [Name "b"])) +> ]) + + +TODO: lots more combos of table elements +and types and the other bits in a column def + 11.10 ::=