diff --git a/Language/SQL/SimpleSQL/Dialect.lhs b/Language/SQL/SimpleSQL/Dialect.lhs index c6bcfb3..ab93c8c 100644 --- a/Language/SQL/SimpleSQL/Dialect.lhs +++ b/Language/SQL/SimpleSQL/Dialect.lhs @@ -90,6 +90,8 @@ Data types to represent different dialect options > ,diSqlServerSymbols :: Bool > -- | allow sql server style for CONVERT function in format CONVERT(data_type(length), expression, style) > ,diConvertFunction :: Bool +> -- | allow creating autoincrement columns +> ,diAutoincrement :: Bool > } > deriving (Eq,Show,Read,Data,Typeable) @@ -112,6 +114,7 @@ Data types to represent different dialect options > ,diPostgresSymbols = False > ,diSqlServerSymbols = False > ,diConvertFunction = False +> ,diAutoincrement = False > } > -- | mysql dialect diff --git a/Language/SQL/SimpleSQL/Parse.lhs b/Language/SQL/SimpleSQL/Parse.lhs index 89a1e37..7674c51 100644 --- a/Language/SQL/SimpleSQL/Parse.lhs +++ b/Language/SQL/SimpleSQL/Parse.lhs @@ -1587,13 +1587,19 @@ TODO: change style > colConstraintDef :: Parser ColConstraintDef > colConstraintDef = > ColConstraintDef -> <$> (optionMaybe (keyword_ "constraint" *> names)) +> <$> optionMaybe (keyword_ "constraint" *> names) > <*> (nullable <|> notNull <|> unique <|> primaryKey <|> check <|> references) > where > nullable = ColNullableConstraint <$ keyword "null" > notNull = ColNotNullConstraint <$ keywords_ ["not", "null"] > unique = ColUniqueConstraint <$ keyword_ "unique" -> primaryKey = ColPrimaryKeyConstraint <$ keywords_ ["primary", "key"] +> primaryKey = do +> keywords_ ["primary", "key"] +> d <- getState +> autoincrement <- if diAutoincrement d +> then optionMaybe (keyword_ "autoincrement") +> else pure Nothing +> pure $ ColPrimaryKeyConstraint $ isJust autoincrement > check = keyword_ "check" >> ColCheckConstraint <$> parens scalarExpr > references = keyword_ "references" >> > (\t c m (ou,od) -> ColReferencesConstraint t c m ou od) diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 272e63e..44ac911 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/Language/SQL/SimpleSQL/Pretty.lhs @@ -702,7 +702,8 @@ Try to do this when this code is ported to a modern pretty printing lib. > <+> pcon con > pcon ColNotNullConstraint = texts ["not","null"] > pcon ColUniqueConstraint = text "unique" -> pcon ColPrimaryKeyConstraint = texts ["primary","key"] +> pcon (ColPrimaryKeyConstraint autoincrement) = +> texts $ ["primary","key"] ++ ["autoincrement"|autoincrement] > pcon (ColCheckConstraint v) = text "check" <+> parens (scalarExpr d v) > pcon (ColReferencesConstraint tb c m u del) = > text "references" diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index 6c90cdc..6e1753f 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/Language/SQL/SimpleSQL/Syntax.lhs @@ -44,6 +44,7 @@ > ,IdentityWhen(..) > ,SequenceGeneratorOption(..) > ,ColConstraintDef(..) +> ,AutoincrementClause > ,ColConstraint(..) > ,TableConstraint(..) > ,ReferenceMatch(..) @@ -575,11 +576,13 @@ I'm not sure if this is valid syntax or not. > -- (Maybe [ConstraintCharacteristics]) > deriving (Eq,Show,Read,Data,Typeable) +> type AutoincrementClause = Bool +> > data ColConstraint = > ColNullableConstraint > | ColNotNullConstraint > | ColUniqueConstraint -> | ColPrimaryKeyConstraint +> | ColPrimaryKeyConstraint AutoincrementClause > | ColReferencesConstraint [Name] (Maybe Name) > ReferenceMatch > ReferentialAction @@ -730,6 +733,6 @@ I'm not sure if this is valid syntax or not. > -- | Comment. Useful when generating SQL code programmatically. The > -- parser doesn't produce these. -> data Comment = BlockComment String +> newtype Comment = BlockComment String > deriving (Eq,Show,Read,Data,Typeable) diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs b/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs index f2ca34d..d60ae64 100644 --- a/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs +++ b/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs @@ -332,7 +332,13 @@ todo: constraint characteristics > "create table t (a int primary key);" > $ CreateTable [Name Nothing "t"] > [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing -> [ColConstraintDef Nothing ColPrimaryKeyConstraint]]) +> [ColConstraintDef Nothing (ColPrimaryKeyConstraint False)]]) + +> ,(TestStatement ansi2011 { diAutoincrement = True } +> "create table t (a int primary key autoincrement);" +> $ CreateTable [Name Nothing "t"] +> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing +> [ColConstraintDef Nothing (ColPrimaryKeyConstraint True)]]) references t(a,b) [ Full |partial| simepl]