add alter table variations:

set default
  drop default
  set not null
  drop not null
  set data type
  drop column
  add constraint
  drop constraint

fix bug where generated didn't have to be followed with 'always' or
  'by default' for identities in create table

Language/SQL/SimpleSQL/Parser.lhs

@@ -1461,7 +1461,7 @@ TODO: change style
 >     CreateTable
 >     <$> names
 >     -- todo: is this order mandatory or is it a perm?
->     <*> parens (commaSep1 (tableConstraintDef
+>     <*> parens (commaSep1 (uncurry TableConstraintDef <$> tableConstraintDef
 >                            <|> TableColumnDef <$> columnDef))
 
 > columnDef :: Parser ColumnDef
@@ -1477,8 +1477,7 @@ TODO: change style
 >              GenerationClause <$> parens valueExpr)
 >        ,keyword_ "generated" >>
 >         IdentityColumnSpec
->         <$> option GeneratedDefault
->             (GeneratedAlways <$ keyword_ "always"
+>         <$> (GeneratedAlways <$ keyword_ "always"
 >              <|> GeneratedByDefault <$ keywords_ ["by", "default"])
 >         <*> (keywords_ ["as", "identity"] *>
 >              option [] (parens sequenceGeneratorOptions))
@@ -1509,9 +1508,9 @@ TODO: change style
 >     scycle = SGOCycle <$ keyword_ "cycle"
 >     noCycle = SGONoCycle <$ try (keywords_ ["no","cycle"])
 
-> tableConstraintDef :: Parser TableElement
+> tableConstraintDef :: Parser (Maybe [Name], TableConstraint)
 > tableConstraintDef =
->     TableConstraintDef
+>     (,)
 >     <$> (optionMaybe (keyword_ "constraint" *> names))
 >     <*> (unique <|> primaryKey <|> check <|> references)
 >   where
@@ -1575,11 +1574,40 @@ slightly hacky parser for signed integers
 
 > alterTable :: Parser Statement
 > alterTable = keyword_ "table" >>
->     AlterTable <$> names <*> choice [addColumnDef]
+>     -- the choices have been ordered so that it works
+>     AlterTable <$> names <*> choice [addConstraint
+>                                     ,dropConstraint
+>                                     ,addColumnDef
+>                                     ,alterColumn
+>                                     ,dropColumn
+>                                     ]
 >   where
 >     addColumnDef = try (keyword_ "add"
 >                         *> optional (keyword_ "column")) >>
 >                    AddColumnDef <$> columnDef
+>     alterColumn = keyword_ "alter" >> optional (keyword_ "column") >>
+>                   name <**> choice [setDefault
+>                                    ,dropDefault
+>                                    ,setNotNull
+>                                    ,dropNotNull
+>                                    ,setDataType]
+>     setDefault :: Parser (Name -> AlterTableAction)
+>     -- todo: left factor
+>     setDefault = try (keywords_ ["set","default"]) >>
+>                  valueExpr <$$> AlterColumnSetDefault
+>     dropDefault = AlterColumnDropDefault <$ try (keywords_ ["drop","default"])
+>     setNotNull = AlterColumnSetNotNull <$ try (keywords_ ["set","not","null"])
+>     dropNotNull = AlterColumnDropNotNull <$ try (keywords_ ["drop","not","null"])
+>     setDataType = try (keywords_ ["set","data","type"]) >>
+>                   typeName <$$> AlterColumnSetDataType
+>     dropColumn = try (keyword_ "drop" *> optional (keyword_ "column")) >>
+>                  DropColumn <$> name <*> dropBehaviour
+>     -- todo: left factor, this try is especially bad
+>     addConstraint = try (keyword_ "add" >>
+>         uncurry AddTableConstraintDef <$> tableConstraintDef)
+>     dropConstraint = try (keywords_ ["drop","constraint"]) >>
+>         DropTableConstraintDef <$> names <*> dropBehaviour
+
 
 > dropSchema :: Parser Statement
 > dropSchema = keyword_ "schema" >>

Language/SQL/SimpleSQL/Pretty.lhs

@@ -459,22 +459,8 @@ which have been changed to try to improve the layout of the output.
 >   where
 >     cd (TableConstraintDef n con) =
 >         maybe empty (\s -> text "constraint" <+> names s) n
->         <+> ptcon con
+>         <+> tableConstraint d con
 >     cd (TableColumnDef cd') = columnDef d cd'
->     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)
 
 > statement d (AlterTable t act) =
 >     texts ["alter","table"] <+> names t
@@ -543,7 +529,6 @@ which have been changed to try to improve the layout of the output.
 >              Just (IdentityColumnSpec w o) ->
 >                  text "generated"
 >                  <+> (case w of
->                          GeneratedDefault -> empty
 >                          GeneratedAlways -> text "always"
 >                          GeneratedByDefault -> text "by" <+> text "default")
 >                  <+> text "as" <+> text "identity"
@@ -595,6 +580,65 @@ which have been changed to try to improve the layout of the output.
 > alterTableAction d (AddColumnDef cd) =
 >     texts ["add", "column"] <+> columnDef d cd
 
+> alterTableAction d (AlterColumnSetDefault n v) =
+>     texts ["alter", "column"]
+>     <+> name n
+>     <+> texts ["set","default"] <+> valueExpr d v
+> alterTableAction _ (AlterColumnDropDefault n) =
+>     texts ["alter", "column"]
+>     <+> name n
+>     <+> texts ["drop","default"]
+
+> alterTableAction _ (AlterColumnSetNotNull n) =
+>     texts ["alter", "column"]
+>     <+> name n
+>     <+> texts ["set","not","null"]
+
+> alterTableAction _ (AlterColumnDropNotNull n) =
+>     texts ["alter", "column"]
+>     <+> name n
+>     <+> texts ["drop","not","null"]
+
+> alterTableAction _ (AlterColumnSetDataType n t) =
+>     texts ["alter", "column"]
+>     <+> name n
+>     <+> texts ["set","data","Type"]
+>     <+> typeName t
+
+> alterTableAction _ (DropColumn n b) =
+>     texts ["drop", "column"]
+>     <+> name n
+>     <+> dropBehav b
+
+> alterTableAction d (AddTableConstraintDef n con) =
+>     text "add"
+>     <+> maybe empty (\s -> text "constraint" <+> names s) n
+>     <+> tableConstraint d con
+
+> alterTableAction _ (DropTableConstraintDef n b) =
+>     texts ["drop", "constraint"]
+>     <+> names n
+>     <+> dropBehav b
+
+
+> tableConstraint :: Dialect -> TableConstraint -> Doc
+> tableConstraint _ (TableUniqueConstraint ns) =
+>          text "unique" <+> parens (commaSep $ map name ns)
+> tableConstraint _ (TablePrimaryKeyConstraint ns) =
+>         texts ["primary","key"] <+> parens (commaSep $ map name ns)
+> tableConstraint _ (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
+> tableConstraint d (TableCheckConstraint v) = text "check" <+> parens (valueExpr d v)
+
+
+
 = utils
 
 > commaSep :: [Doc] -> Doc

Language/SQL/SimpleSQL/Syntax.lhs

@@ -553,13 +553,18 @@ I'm not sure if this is valid syntax or not.
 
 > data AlterTableAction =
 >     AddColumnDef ColumnDef
->   {-
->   | AlterColumnDef
->   | DropColumnDef
->   | AddTableConstraintDef
->   | AlterTableConstraintDef
->   | DropTableConstraintDef
->   -}
+>   | AlterColumnSetDefault Name ValueExpr
+>   | AlterColumnDropDefault Name
+>   | AlterColumnSetNotNull Name
+>   | AlterColumnDropNotNull Name
+>   | AlterColumnSetDataType Name TypeName
+>   {-  | AlterColumnAlterIdentity
+>   | AlterColumnDropIdentity
+>   | AlterColumnDropColumnGeneration-}
+>   | DropColumn Name DropBehaviour
+>   | AddTableConstraintDef (Maybe [Name]) TableConstraint
+>   --  | AlterTableConstraintDef
+>   | DropTableConstraintDef [Name] DropBehaviour
 >     deriving (Eq,Show,Read,Data,Typeable)
 
 > {-data ConstraintCharacteristics =
@@ -597,8 +602,7 @@ I'm not sure if this is valid syntax or not.
 >     deriving (Eq,Show,Read,Data,Typeable)
 
 > data IdentityWhen =
->     GeneratedDefault
->   | GeneratedAlways
+>     GeneratedAlways
 >   | GeneratedByDefault
 >     deriving (Eq,Show,Read,Data,Typeable)