diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs index b68bc73..d3960b9 100644 --- a/Language/SQL/SimpleSQL/Parser.lhs +++ b/Language/SQL/SimpleSQL/Parser.lhs @@ -1465,10 +1465,12 @@ TODO: change style > createTable = keyword_ "table" >> > CreateTable > <$> names +> -- todo: is this order mandatory or is it a perm? > <*> parens (commaSep1 columnDef) > where > columnDef = ColumnDef <$> name <*> typeName > <*> optionMaybe defaultClause +> <*> option [] (many1 constraintDef) > defaultClause = choice [ > keyword_ "default" >> > DefaultClause <$> valueExpr @@ -1509,6 +1511,39 @@ TODO: change style > scycle = SGOCycle <$ keyword_ "cycle" > noCycle = SGONoCycle <$ try (keywords_ ["no","cycle"]) + +> constraintDef :: Parser ConstraintDef +> constraintDef = +> ConstraintDef +> <$> (optionMaybe (keyword_ "constraint" *> names)) +> <*> (notNull <|> 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 +> (keyword_ "match" *> +> choice [MatchFull <$ keyword_ "full" +> ,MatchPartial <$ keyword_ "partial" +> ,MatchSimple <$ keyword_ "simple"]) +> <*> permute ((,) <$?> (DefaultReferentialAction, onUpdate) +> <|?> (DefaultReferentialAction, onDelete)) +> -- todo: left factor? +> onUpdate = try (keywords_ ["on", "update"]) *> referentialAction +> onDelete = try (keywords_ ["on", "delete"]) *> referentialAction +> referentialAction = choice [ +> RefCascade <$ keyword_ "cascade" +> -- todo: left factor? +> ,RefSetNull <$ try (keywords_ ["set", "null"]) +> ,RefSetDefault <$ try (keywords_ ["set", "default"]) +> ,RefRestrict <$ keyword_ "restrict" +> ,RefNoAction <$ keywords_ ["no", "action"]] + slightly hacky parser for signed integers > signedInteger :: Parser Integer diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 39f2162..0681fe2 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/Language/SQL/SimpleSQL/Pretty.lhs @@ -457,7 +457,7 @@ which have been changed to try to improve the layout of the output. > text "create" <+> text "table" <+> names nm > <+> parens (commaSep $ map cd cds) > where -> cd (ColumnDef n t mdef) = +> cd (ColumnDef n t mdef cons) = > name n <+> typeName t > <+> case mdef of > Nothing -> empty @@ -475,6 +475,7 @@ which have been changed to try to improve the layout of the output. > <+> (case o of > [] -> empty > os -> parens (sep $ map sgo os)) +> <+> sep (map cdef cons) > sgo (SGOStartWith i) = texts ["start", "with", show i] > sgo (SGOIncrementBy i) = texts ["increment", "by", show i] > sgo (SGOMaxValue i) = texts ["maxvalue", show i] @@ -483,6 +484,36 @@ 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) = +> 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) = +> 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"]) > 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 0cdf102..bbefad7 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/Language/SQL/SimpleSQL/Syntax.lhs @@ -40,6 +40,10 @@ > ,DefaultClause(..) > ,IdentityWhen(..) > ,SequenceGeneratorOption(..) +> ,ConstraintDef(..) +> ,Constraint(..) +> ,ReferenceMatch(..) +> ,ReferentialAction(..) > -- * Dialect > ,Dialect(..) > -- * Comment @@ -493,11 +497,68 @@ I'm not sure if this is valid syntax or not. > data TableElement = > ColumnDef Name TypeName > (Maybe DefaultClause) -> -- (Maybe ColumnConstraintDef) +> [ConstraintDef] > -- (Maybe CollateClause) > -- | TableConstraintDef > deriving (Eq,Show,Read,Data,Typeable) +> data ConstraintDef = +> ConstraintDef (Maybe [Name]) Constraint +> -- (Maybe [ConstraintCharacteristics]) +> deriving (Eq,Show,Read,Data,Typeable) + +> data Constraint = +> NotNullConstraint +> | UniqueConstraint +> | PrimaryKeyConstraint +> | ReferencesConstraint [Name] (Maybe Name) +> ReferenceMatch +> ReferentialAction +> ReferentialAction +> | CheckConstraint ValueExpr +> deriving (Eq,Show,Read,Data,Typeable) + +> data ReferenceMatch = +> DefaultReferenceMatch +> | MatchFull +> | MatchPartial +> | MatchSimple +> deriving (Eq,Show,Read,Data,Typeable) + +> data ReferentialAction = +> DefaultReferentialAction +> | RefCascade +> | RefSetNull +> | RefSetDefault +> | RefRestrict +> | RefNoAction +> deriving (Eq,Show,Read,Data,Typeable) + +> {-data ConstraintCharacteristics = +> ConstraintCharacteristics +> ConstraintCheckTime +> Deferrable +> ConstraintEnforcement +> deriving (Eq,Show,Read,Data,Typeable) + +> data ConstraintCheckTime = +> DefaultConstraintCheckTime +> | InitiallyDeferred +> | InitiallyImmeditate +> deriving (Eq,Show,Read,Data,Typeable) + +> data Deferrable = +> DefaultDefferable +> | Deferrable +> | NotDeferrable +> deriving (Eq,Show,Read,Data,Typeable) + +> data ConstraintEnforcement = +> DefaultConstraintEnforcement +> | Enforced +> | NotEnforced +> deriving (Eq,Show,Read,Data,Typeable) -} + > {-data TableConstraintDef > deriving (Eq,Show,Read,Data,Typeable) -} diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs b/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs index 85d85cc..d3c59e9 100644 --- a/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs +++ b/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs @@ -1,16 +1,28 @@ -This file goes through the grammar for SQL 2011 (using the draft standard). +This file goes through the grammar for SQL 2011 queries (using the +draft standard). -We are only looking at the query syntax, and no other parts. +There are other files which cover some of the other sections from SQL +2011 (ddl, non-query dml, etc). + +Possible sections not in the todo which could +be covered: -There are other files which cover some of the other sections. -Possible sections not covered yet: 13 modules 16 control statements +18 connection management 20 dynamic 22 direct 23 diagnostics +procedural sql + +some of the main areas being left for now: +temporal and versioning stuff +modules +ref stuff +todo: finish this list + The goal is to create some example tests for each bit of grammar, with diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs b/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs index 6b1a060..bbe668c 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"]) Nothing -> ,ColumnDef (Name "b") (TypeName [Name "int"]) Nothing]) +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] +> ,ColumnDef (Name "b") (TypeName [Name "int"]) Nothing []]) ::= @@ -296,6 +296,154 @@ defintely skip | | + +can have more than one +whitespace separated + +one constratint: +optional name: constraint [Name] +not null | unique | references | check +todo: constraint characteristics + + +> ,(TestStatement SQL2011 +> "create table t (a int not null);" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> [ConstraintDef Nothing NotNullConstraint]]) + +> ,(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]]) + +> ,(TestStatement SQL2011 +> "create table t (a int unique);" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> [ConstraintDef Nothing UniqueConstraint]]) + +> ,(TestStatement SQL2011 +> "create table t (a int primary key);" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> [ConstraintDef Nothing PrimaryKeyConstraint]]) + +references t(a,b) + [ Full |partial| simepl] + [perm: on update [cascade | set null | set default | restrict | no action] + on delete "" + +> ,(TestStatement SQL2011 +> "create table t (a int references u);" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> [ConstraintDef Nothing $ ReferencesConstraint +> [Name "u"] Nothing DefaultReferenceMatch +> DefaultReferentialAction DefaultReferentialAction]]) + +> ,(TestStatement SQL2011 +> "create table t (a int references u(a));" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> [ConstraintDef Nothing $ ReferencesConstraint +> [Name "u"] (Just $ Name "a") DefaultReferenceMatch +> DefaultReferentialAction DefaultReferentialAction]]) + +> ,(TestStatement SQL2011 +> "create table t (a int references u match full);" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> [ConstraintDef Nothing $ ReferencesConstraint +> [Name "u"] Nothing MatchFull +> DefaultReferentialAction DefaultReferentialAction]]) + +> ,(TestStatement SQL2011 +> "create table t (a int references u match partial);" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> [ConstraintDef Nothing $ ReferencesConstraint +> [Name "u"] Nothing MatchPartial +> DefaultReferentialAction DefaultReferentialAction]]) + +> ,(TestStatement SQL2011 +> "create table t (a int references u match simple);" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> [ConstraintDef Nothing $ ReferencesConstraint +> [Name "u"] Nothing MatchSimple +> DefaultReferentialAction DefaultReferentialAction]]) + +> ,(TestStatement SQL2011 +> "create table t (a int references u on update cascade );" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> [ConstraintDef Nothing $ ReferencesConstraint +> [Name "u"] Nothing DefaultReferenceMatch +> RefCascade DefaultReferentialAction]]) + +> ,(TestStatement SQL2011 +> "create table t (a int references u on update set null );" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> [ConstraintDef Nothing $ ReferencesConstraint +> [Name "u"] Nothing DefaultReferenceMatch +> RefSetNull DefaultReferentialAction]]) + +> ,(TestStatement SQL2011 +> "create table t (a int references u on update set default );" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> [ConstraintDef Nothing $ ReferencesConstraint +> [Name "u"] Nothing DefaultReferenceMatch +> RefSetDefault DefaultReferentialAction]]) + +> ,(TestStatement SQL2011 +> "create table t (a int references u on update no action );" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> [ConstraintDef Nothing $ ReferencesConstraint +> [Name "u"] Nothing DefaultReferenceMatch +> RefNoAction DefaultReferentialAction]]) + +> ,(TestStatement SQL2011 +> "create table t (a int references u on delete cascade );" +> $ CreateTable [Name "t"] +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> [ConstraintDef Nothing $ ReferencesConstraint +> [Name "u"] Nothing DefaultReferenceMatch +> DefaultReferentialAction RefCascade]]) + + +> ,(TestStatement SQL2011 +> "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 +> [Name "u"] Nothing DefaultReferenceMatch +> RefCascade RefRestrict]]) + +> ,(TestStatement SQL2011 +> "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 +> [Name "u"] Nothing DefaultReferenceMatch +> RefCascade RefRestrict]]) + +> ,(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"))]]) + + +check (valueexpr) + + + ::= GENERATED { ALWAYS | BY DEFAULT } AS IDENTITY [ ] @@ -303,17 +451,17 @@ defintely skip > ,(TestStatement SQL2011 "create table t (a int generated as identity);" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) -> (Just $ IdentityColumnSpec GeneratedDefault [])]) +> (Just $ IdentityColumnSpec GeneratedDefault []) []]) > ,(TestStatement SQL2011 "create table t (a int generated always as identity);" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) -> (Just $ IdentityColumnSpec GeneratedAlways [])]) +> (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 [])]) +> (Just $ IdentityColumnSpec GeneratedByDefault []) []]) > ,(TestStatement SQL2011 @@ -326,7 +474,7 @@ defintely skip > ,SGOIncrementBy 5 > ,SGOMaxValue 500 > ,SGOMinValue 5 -> ,SGOCycle])]) +> ,SGOCycle]) []]) > ,(TestStatement SQL2011 > "create table t (a int generated as identity\ @@ -337,7 +485,7 @@ defintely skip > [SGOStartWith (-4) > ,SGONoMaxValue > ,SGONoMinValue -> ,SGONoCycle])]) +> ,SGONoCycle]) []]) I think is supposed to just whitespace separated. In db2 it seems to be csv, but the grammar here @@ -360,10 +508,10 @@ generated always (valueexpr) > "create table t (a int, \ > \ a2 int generated always as (a * 2));" > $ CreateTable [Name "t"] -> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing +> [ColumnDef (Name "a") (TypeName [Name "int"]) Nothing [] > ,ColumnDef (Name "a2") (TypeName [Name "int"]) > (Just $ GenerationClause -> (BinOp (Iden [Name "a"]) [Name "*"] (NumLit "2")))]) +> (BinOp (Iden [Name "a"]) [Name "*"] (NumLit "2"))) []]) @@ -389,7 +537,7 @@ generated always (valueexpr) > ,(TestStatement SQL2011 "create table t (a int default 0);" > $ CreateTable [Name "t"] > [ColumnDef (Name "a") (TypeName [Name "int"]) -> (Just $ DefaultClause $ NumLit "0")]) +> (Just $ DefaultClause $ NumLit "0") []])