Merge pull request #50 from Airsequel/autoincrement

Support autoincrement columns
JakeWheat · Jan 8, 2024 · d8b32c0 · d8b32c0
2 parents 6957a39 + d53afd9
commit d8b32c0
Show file tree

Hide file tree

Showing 5 changed files with 25 additions and 6 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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]