add alter table add column support

Language/SQL/SimpleSQL/Parser.lhs

@@ -1441,15 +1441,10 @@ TODO: change style
 
 > statement :: Parser Statement
 > statement = choice
->     [keyword_ "create"
->      *> choice
->         [createSchema
->         ,createTable
->         ]
->     ,keyword_ "drop"
->      *> choice
->         [dropSchema
->         ]
+>     [keyword_ "create" *> choice [createSchema
+>                                  ,createTable]
+>     ,keyword_ "alter" *> choice [alterTable]
+>     ,keyword_ "drop" *> choice [dropSchema]
 >     ,delete
 >     ,truncateSt
 >     ,insert
@@ -1466,11 +1461,14 @@ TODO: change style
 >     CreateTable
 >     <$> names
 >     -- todo: is this order mandatory or is it a perm?
->     <*> parens (commaSep1 (tableConstraintDef <|> columnDef))
+>     <*> parens (commaSep1 (tableConstraintDef
+>                            <|> TableColumnDef <$> columnDef))
+
+> columnDef :: Parser ColumnDef
+> columnDef = ColumnDef <$> name <*> typeName
+>             <*> optionMaybe defaultClause
+>             <*> option [] (many1 colConstraintDef)
 >   where
->     columnDef = ColumnDef <$> name <*> typeName
->                 <*> optionMaybe defaultClause
->                 <*> option [] (many1 colConstraintDef)
 >     defaultClause = choice [
 >         keyword_ "default" >>
 >         DefaultClause <$> valueExpr
@@ -1571,10 +1569,17 @@ TODO: change style
 slightly hacky parser for signed integers
 
 > signedInteger :: Parser Integer
-> signedInteger = do
->     s <- option 1 (1 <$ symbol "+" <|> (-1) <$ symbol "-")
->     d <- unsignedInteger
->     return $ s * d
+> signedInteger =
+>     (*) <$> option 1 (1 <$ symbol "+" <|> (-1) <$ symbol "-")
+>     <*> unsignedInteger
+
+> alterTable :: Parser Statement
+> alterTable = keyword_ "table" >>
+>     AlterTable <$> names <*> choice [addColumnDef]
+>   where
+>     addColumnDef = try (keyword_ "add"
+>                         *> optional (keyword_ "column")) >>
+>                    AddColumnDef <$> columnDef
 
 > dropSchema :: Parser Statement
 > dropSchema = keyword_ "schema" >>

Language/SQL/SimpleSQL/Pretty.lhs

@@ -457,28 +457,10 @@ 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 cons) =
->       name n <+> typeName t
->       <+> case mdef of
->              Nothing -> empty
->              Just (DefaultClause def) ->
->                  text "default" <+> valueExpr d def
->              Just (GenerationClause e) ->
->                  texts ["generated","always","as"] <+> parens (valueExpr d e)
->              Just (IdentityColumnSpec w o) ->
->                  text "generated"
->                  <+> (case w of
->                          GeneratedDefault -> empty
->                          GeneratedAlways -> text "always"
->                          GeneratedByDefault -> text "by" <+> text "default")
->                  <+> text "as" <+> text "identity"
->                  <+> (case o of
->                          [] -> 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
+>     cd (TableColumnDef cd') = columnDef d cd'
 >     ptcon (TableUniqueConstraint ns) =
 >          text "unique" <+> parens (commaSep $ map name ns)
 >     ptcon (TablePrimaryKeyConstraint ns) =
@@ -494,40 +476,9 @@ which have been changed to try to improve the layout of the output.
 >         <+> 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]
->     sgo SGONoMaxValue = texts ["no", "maxvalue"]
->     sgo (SGOMinValue i) = texts ["minvalue", show i]
->     sgo SGONoMinValue = texts ["no", "minvalue"]
->     sgo SGOCycle = text "cycle"
->     sgo SGONoCycle = text "no cycle"
->     cdef (ColConstraintDef cnm con) =
->         maybe empty (\s -> text "constraint" <+> names s) cnm
->         <+> pcon con
->     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
->         <+> 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 d (AlterTable t act) =
+>     texts ["alter","table"] <+> names t
+>     <+> alterTableAction d act
 
 > statement _ (DropSchema nm db) =
 >     text "drop" <+> text "schema" <+> names nm <+> dropBehav db
@@ -580,6 +531,70 @@ which have been changed to try to improve the layout of the output.
 > dropBehav Restrict = text "restrict"
 
 
+> columnDef :: Dialect -> ColumnDef -> Doc
+> columnDef d (ColumnDef n t mdef cons) =
+>       name n <+> typeName t
+>       <+> case mdef of
+>              Nothing -> empty
+>              Just (DefaultClause def) ->
+>                  text "default" <+> valueExpr d def
+>              Just (GenerationClause e) ->
+>                  texts ["generated","always","as"] <+> parens (valueExpr d e)
+>              Just (IdentityColumnSpec w o) ->
+>                  text "generated"
+>                  <+> (case w of
+>                          GeneratedDefault -> empty
+>                          GeneratedAlways -> text "always"
+>                          GeneratedByDefault -> text "by" <+> text "default")
+>                  <+> text "as" <+> text "identity"
+>                  <+> (case o of
+>                          [] -> empty
+>                          os -> parens (sep $ map sgo os))
+>       <+> sep (map cdef cons)
+>   where
+>     sgo (SGOStartWith i) = texts ["start",  "with", show i]
+>     sgo (SGOIncrementBy i) = texts ["increment", "by", show i]
+>     sgo (SGOMaxValue i) = texts ["maxvalue", show i]
+>     sgo SGONoMaxValue = texts ["no", "maxvalue"]
+>     sgo (SGOMinValue i) = texts ["minvalue", show i]
+>     sgo SGONoMinValue = texts ["no", "minvalue"]
+>     sgo SGOCycle = text "cycle"
+>     sgo SGONoCycle = text "no cycle"
+>     cdef (ColConstraintDef cnm con) =
+>         maybe empty (\s -> text "constraint" <+> names s) cnm
+>         <+> pcon con
+>     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 tb c m u del) =
+>         text "references"
+>         <+> names tb
+>         <+> maybe empty (\c' -> parens (name c')) c
+>         <+> refMatch m
+>         <+> refAct "update" u
+>         <+> refAct "delete" del
+
+> refMatch :: ReferenceMatch -> Doc
+> refMatch m = case m of
+>                      DefaultReferenceMatch -> empty
+>                      MatchFull -> texts ["match", "full"]
+>                      MatchPartial -> texts ["match","partial"]
+>                      MatchSimple -> texts ["match", "simple"]
+
+> refAct :: String -> ReferentialAction -> Doc
+> 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"]
+
+> alterTableAction :: Dialect -> AlterTableAction -> Doc
+> alterTableAction d (AddColumnDef cd) =
+>     texts ["add", "column"] <+> columnDef d cd
+
 = utils
 
 > commaSep :: [Doc] -> Doc

Language/SQL/SimpleSQL/Syntax.lhs

@@ -37,6 +37,7 @@
 >     ,InsertSource(..)
 >     ,SetClause(..)
 >     ,TableElement(..)
+>     ,ColumnDef(..)
 >     ,DefaultClause(..)
 >     ,IdentityWhen(..)
 >     ,SequenceGeneratorOption(..)
@@ -45,6 +46,7 @@
 >     ,TableConstraint(..)
 >     ,ReferenceMatch(..)
 >     ,ReferentialAction(..)
+>     ,AlterTableAction(..)
 >      -- * Dialect
 >     ,Dialect(..)
 >      -- * Comment
@@ -402,8 +404,8 @@ I'm not sure if this is valid syntax or not.
 >     CreateSchema [Name] -- XXX
 >   | DropSchema [Name] DropBehaviour -- XXX
 >   | CreateTable [Name] [TableElement]
->   {-  | AlterTable -- XXX
->   | DropTable  -- XXX
+>   | AlterTable [Name] AlterTableAction
+>   {-  | DropTable  -- XXX
 >   | CreateView  -- XXX
 >   | DropView -- XXX
 >   | CreateDomain  -- XXX
@@ -496,11 +498,14 @@ I'm not sure if this is valid syntax or not.
 >     deriving (Eq,Show,Read,Data,Typeable)
 
 > data TableElement =
->     ColumnDef Name TypeName
+>     TableColumnDef ColumnDef
+>   | TableConstraintDef (Maybe [Name]) TableConstraint
+>     deriving (Eq,Show,Read,Data,Typeable)
+
+> data ColumnDef = ColumnDef Name TypeName
 >        (Maybe DefaultClause)
 >        [ColConstraintDef]
 >        -- (Maybe CollateClause)
->   | TableConstraintDef (Maybe [Name]) TableConstraint
 >     deriving (Eq,Show,Read,Data,Typeable)
 
 > data ColConstraintDef =
@@ -546,6 +551,17 @@ I'm not sure if this is valid syntax or not.
 >   | RefNoAction
 >     deriving (Eq,Show,Read,Data,Typeable)
 
+> data AlterTableAction =
+>     AddColumnDef ColumnDef
+>   {-
+>   | AlterColumnDef
+>   | DropColumnDef
+>   | AddTableConstraintDef
+>   | AlterTableConstraintDef
+>   | DropTableConstraintDef
+>   -}
+>     deriving (Eq,Show,Read,Data,Typeable)
+
 > {-data ConstraintCharacteristics =
 >     ConstraintCharacteristics
 >         ConstraintCheckTime