Add support for PostgreSQL-style ALTER COLUMN syntax

lib/dialect.ml

@@ -402,8 +402,8 @@ and analyze_alter_action acc actions k = match actions with
     | `TtlOptions (_, pos) | `RemoveTtl pos ->
         let acc = get_ttl pos :: acc in
         analyze_alter_action acc rest k
-    | `Drop _ | `RenameTable _ | `RenameColumn _ | `RenameIndex _ | `AddIndex _ | `DropIndex _ | `AddPrimaryKey _ | `DropPrimaryKey | `AddConstraint _ | `DropConstraint _ | `None ->
-
+    | `Drop _ | `RenameTable _ | `RenameColumn _ | `RenameIndex _ | `AddIndex _ | `DropIndex _ | `AddPrimaryKey _ | `DropPrimaryKey | `AddConstraint _ | `DropConstraint _ | `None
+    | `AlterColumnPG _ ->
         analyze_alter_action acc rest k
 
 and analyze_insert_action acc ias k = match ias with

lib/sql.ml

@@ -807,6 +807,16 @@ type ttl_option =
   [ `TtlSet of string * int * string
   | `TtlEnable of string ] [@@deriving show {with_path=false}]
 
+module Alter_column_pg = struct
+  (* Each field is optional: [None] means "don't change this property".
+     [Some x] means "set this property to [x]". *)
+  type t = {
+    typ : Source_type.kind collated located option;
+    not_null : bool option;
+    default : expr located option option;
+  } [@@deriving show {with_path=false}]
+end
+
 type alter_action = [
     | `Add of Alter_action_attr.t * alter_pos
     | `RenameTable of table_name
@@ -823,6 +833,7 @@ type alter_action = [
     | `Default_or_convert_to of (charset_name option * string located option)
     | `TtlOptions of ttl_option list * pos
     | `RemoveTtl of pos
+    | `AlterColumnPG of string * Alter_column_pg.t
     | `None ] [@@deriving show {with_path=false}]
 
 type stmt =

lib/sql_lexer.mll

@@ -197,6 +197,7 @@ let keywords =
    "ttl", TTL;
    "ttl_enable", TTL_ENABLE;
    "remove", REMOVE;
+   "type", TYPE;
   ] in (* more *)
   k := !k @ List.map (fun s -> s, INTERVAL_UNIT s) [ "microsecond"; "second"; "minute"; "hour"; "day"; "week"; "month"; "quarter"; "year" ];
   let all token l = k := !k @ List.map (fun x -> x,token) l in

lib/sql_parser.mly

@@ -36,7 +36,7 @@
        CONCAT_OP LEFT RIGHT FULL INNER OUTER NATURAL CROSS REPLACE IN GROUP HAVING
        UNIQUE PRIMARY KEY FOREIGN AUTOINCREMENT ON CONFLICT DO NOTHING TEMPORARY IF EXISTS
        PRECISION SIGNED UNSIGNED ZEROFILL VARYING CHARSET NATIONAL ASCII UNICODE COLLATE BINARY CHARACTER
-       DATETIME_FUNC DATE TIME TIMESTAMP ALTER RENAME ADD COLUMN CASCADE RESTRICT DROP
+       DATETIME_FUNC DATE TIME TIMESTAMP ALTER RENAME ADD COLUMN CASCADE RESTRICT DROP TYPE
        GLOBAL LOCAL REFERENCES CHECK CONSTRAINT IGNORED AFTER INDEX FULLTEXT SPATIAL FIRST
        CASE WHEN THEN ELSE END CHANGE MODIFY DELAYED ENUM FOR SHARE MODE LOCK
        OF WITH NOWAIT ACTION NO IS INTERVAL SUBSTRING DIV MOD CONVERT LAG LEAD OVER
@@ -354,6 +354,13 @@ maybe_as_with_detupled: AS? name=IDENT names=sequence(IDENT)? { name, names }
 
 maybe_parenth(X): x=X | LPAREN x=X RPAREN { x }
 
+alter_column_pg_spec:
+  | TYPE t=located_sql_type { { Alter_column_pg.typ = Some t; not_null = None; default = None } }
+  | SET NOT NULL { { Alter_column_pg.typ = None; not_null = Some true; default = None } }
+  | DROP NOT NULL { { Alter_column_pg.typ = None; not_null = Some false; default = None } }
+  | SET DEFAULT e=default_value { { Alter_column_pg.typ = None; not_null = None; default = Some (Some (make_located ~value:e ~pos:($startofs, $endofs))) } }
+  | DROP DEFAULT { { Alter_column_pg.typ = None; not_null = None; default = Some None } }
+
 alter_action: ADD COLUMN? col=maybe_parenth(column_def) pos=alter_pos { `Add (col,pos) }
             | ADD index_type name=IDENT? cols=sequence(IDENT) { `AddIndex (name, cols) }
             | ADD CONSTRAINT name=IDENT? table_constraint_1 index_options { `AddConstraint name }
@@ -367,6 +374,7 @@ alter_action: ADD COLUMN? col=maybe_parenth(column_def) pos=alter_pos { `Add (co
             | DROP CHECK name=IDENT { `DropConstraint name }
             | CHANGE COLUMN? old_name=IDENT column=column_def pos=alter_pos { `Change (old_name,column,pos) }
             | MODIFY COLUMN? column=column_def pos=alter_pos { `Change (column.Alter_action_attr.name,column,pos) }
+	    | ALTER COLUMN? col=IDENT spec=alter_column_pg_spec { `AlterColumnPG (col, spec) }
             | SET IDENT IDENT { `None }
             | ALGORITHM EQUAL algorithm { `None }
             | LOCK EQUAL lock { `None }

lib/syntax.ml

@@ -1466,6 +1466,18 @@ let rec eval (stmt:Sql.stmt) =
         Tables.drop_primary_key name
       | `AddPrimaryKey cols ->
         Tables.add_primary_key name ~cols
+      | `AlterColumnPG (col_name, changes) ->
+        Option.may (fun new_type ->
+          Tables.alter_column_type name ~col_name ~new_kind:new_type.value.collated
+        ) changes.Alter_column_pg.typ;
+        Option.may (fun not_null ->
+          if not_null then Tables.alter_column_set_not_null name ~col_name
+          else Tables.alter_column_drop_not_null name ~col_name
+        ) changes.not_null;
+        Option.may (function
+          | Some _ -> Tables.alter_column_set_default name ~col_name
+          | None -> Tables.alter_column_drop_default name ~col_name
+        ) changes.default
       | `RenameIndex _  | `AddIndex _ | `DropIndex _ | `AddConstraint _ | `DropConstraint _ -> () (* indices are not tracked yet *)
       | `TtlOptions _ | `RemoveTtl _ -> () (* TTL is a TiDB-specific table property, not tracked in schema *)
       | `Default_or_convert_to (cs, collation) ->

lib/tables.ml

@@ -124,6 +124,52 @@ let add_primary_key name ~cols:col_names =
       { c with attr = { c.attr with extra = Sql.Constraints.add pk c.attr.Sql.extra } }
     else c))
 
+let alter_column_type name ~col_name ~new_kind =
+  alter name (fun cols ->
+    List.map (fun c ->
+      if c.attr.Sql.name = col_name then
+        let new_t = Sql.Alter_action_attr.kind_to_type_kind new_kind in
+        { attr = { c.attr with domain = { c.attr.domain with Sql.Type.t = new_t } };
+          source_kind = Some new_kind }
+      else c
+    ) cols)
+
+let alter_column_set_not_null name ~col_name =
+  alter name (fun cols ->
+    List.map (fun c ->
+      if c.attr.Sql.name = col_name then
+        { c with attr = { c.attr with
+            domain = { c.attr.domain with Sql.Type.nullability = Strict };
+            extra = Sql.Constraints.add NotNull c.attr.extra } }
+      else c
+    ) cols)
+
+let alter_column_drop_not_null name ~col_name =
+  alter name (fun cols ->
+    List.map (fun c ->
+      if c.attr.Sql.name = col_name then
+        { c with attr = { c.attr with
+            domain = { c.attr.domain with Sql.Type.nullability = Nullable };
+            extra = Sql.Constraints.remove NotNull c.attr.extra } }
+      else c
+    ) cols)
+
+let alter_column_set_default name ~col_name =
+  alter name (fun cols ->
+    List.map (fun c ->
+      if c.attr.Sql.name = col_name then
+        { c with attr = { c.attr with extra = Sql.Constraints.add WithDefault c.attr.extra } }
+      else c
+    ) cols)
+
+let alter_column_drop_default name ~col_name =
+  alter name (fun cols ->
+    List.map (fun c ->
+      if c.attr.Sql.name = col_name then
+        { c with attr = { c.attr with extra = Sql.Constraints.remove WithDefault c.attr.extra } }
+      else c
+    ) cols)
+
 let print ch tables = let out = IO.output_channel ch in List.iter (Sql.print_table out) tables; IO.flush out
 let print_all () = print stdout (List.map (fun (n, cols) -> (n, columns_to_schema cols)) !store)
 let print1 name = print stdout [get @@ Sql.make_table_name name]

src/gen_migrations.ml

@@ -113,6 +113,27 @@ let inverse_action table_name (columns : Tables.column list) (action : Sql.alter
     `Default_or_convert_to (cs, collation)
   | `TtlOptions (_, _) -> `RemoveTtl (0, 0)
   | `RemoveTtl _ -> `None
+  | `AlterColumnPG (col_name, changes) ->
+    let entry = find_column columns col_name in
+    let inv_typ = Option.map (fun _ ->
+      let old = Sql.Alter_action_attr.from_attr entry.attr |> enrich_with_source_kind entry.source_kind in
+      match old.Sql.Alter_action_attr.kind with
+      | Some k -> k
+      | None -> Sql.make_located ~pos:(0,0)
+          ~value:(Sql.make_collated ~collated:(Sql.Source_type.Infer entry.attr.domain.Sql.Type.t) ())
+    ) changes.Sql.Alter_column_pg.typ in
+    let inv_not_null = Option.map (fun _ ->
+      Sql.Type.is_strict entry.attr.domain
+    ) changes.not_null in
+    let inv_default = Option.map (fun _ ->
+      if Sql.Constraints.mem WithDefault entry.attr.extra then
+        let col = Sql.Alter_action_attr.from_attr entry.attr in
+        List.find_map (fun (c : Sql.Alter_action_attr.constraint_ Sql.located) ->
+          match c.value with Sql.Alter_action_attr.Default e -> Some (Some e) | _ -> None
+        ) col.extra |> Option.default None
+      else None
+    ) changes.default in
+    `AlterColumnPG (col_name, { Sql.Alter_column_pg.typ = inv_typ; not_null = inv_not_null; default = inv_default })
   | `None -> `None
 
 let action_to_sql_fragment (action : Sql.alter_action) =
@@ -166,6 +187,21 @@ let action_to_sql_fragment (action : Sql.alter_action) =
     in
     String.concat " " (List.map opt_to_sql opts)
   | `RemoveTtl _ -> "REMOVE TTL"
+  | `AlterColumnPG (col_name, changes) ->
+    let parts = List.filter_map Fun.id [
+      Option.map (fun t ->
+        sprintf "ALTER COLUMN %s TYPE %s" (quote_id col_name) (source_type_kind_to_sql t.Sql.value.Sql.collated)
+      ) changes.Sql.Alter_column_pg.typ;
+      Option.map (fun b ->
+        if b then sprintf "ALTER COLUMN %s SET NOT NULL" (quote_id col_name)
+        else sprintf "ALTER COLUMN %s DROP NOT NULL" (quote_id col_name)
+      ) changes.not_null;
+      Option.map (function
+        | Some _ -> sprintf "ALTER COLUMN %s SET DEFAULT (* unknown *)" (quote_id col_name)
+        | None -> sprintf "ALTER COLUMN %s DROP DEFAULT" (quote_id col_name)
+      ) changes.default;
+    ] in
+    String.concat ", " parts
   | `None -> "(* unsupported: index/constraint operation *)"
 
 let alter_to_sql table_name actions =

test/alter.sql

@@ -8,3 +8,19 @@ CREATE INDEX `foo_unique` ON `foo` (`col1`, `col2`, `col3`);
 ALTER TABLE `foo`
 DROP INDEX `foo_unique`,
 ADD UNIQUE `foo_unique` (`col1`, `col3`);
+
+CREATE TABLE "bar" (
+  "id" INTEGER NOT NULL,
+  "role" SMALLINT NOT NULL,
+  "role_new" INTEGER NOT NULL,
+  "omniscience" INTEGER NOT NULL
+);
+
+ALTER TABLE "bar"
+  DROP COLUMN "role",
+  ALTER COLUMN "role_new" TYPE SMALLINT,
+  ALTER COLUMN "role_new" SET NOT NULL,
+  ALTER COLUMN "omniscience" TYPE BOOLEAN,
+  ALTER COLUMN "omniscience" SET NOT NULL;
+
+ALTER TABLE "bar" RENAME COLUMN "role_new" TO "role";

test/out/alter.xml

@@ -13,6 +13,25 @@
   <in/>
   <out/>
  </stmt>
+ <stmt name="create_bar" sql="CREATE TABLE &quot;bar&quot; (&#x0A;  &quot;id&quot; INTEGER NOT NULL,&#x0A;  &quot;role&quot; SMALLINT NOT NULL,&#x0A;  &quot;role_new&quot; INTEGER NOT NULL,&#x0A;  &quot;omniscience&quot; INTEGER NOT NULL&#x0A;)" category="DDL" kind="create" target="bar" cardinality="0">
+  <in/>
+  <out/>
+ </stmt>
+ <stmt name="alter_bar_4" sql="ALTER TABLE &quot;bar&quot;&#x0A;  DROP COLUMN &quot;role&quot;,&#x0A;  ALTER COLUMN &quot;role_new&quot; TYPE SMALLINT,&#x0A;  ALTER COLUMN &quot;role_new&quot; SET NOT NULL,&#x0A;  ALTER COLUMN &quot;omniscience&quot; TYPE BOOLEAN,&#x0A;  ALTER COLUMN &quot;omniscience&quot; SET NOT NULL" category="DDL" kind="alter" target="bar" cardinality="0">
+  <in/>
+  <out/>
+ </stmt>
+ <stmt name="alter_bar_5" sql="ALTER TABLE &quot;bar&quot; RENAME COLUMN &quot;role_new&quot; TO &quot;role&quot;" category="DDL" kind="alter" target="bar" cardinality="0">
+  <in/>
+  <out/>
+ </stmt>
+ <table name="bar">
+  <schema>
+   <value name="id" type="Int"/>
+   <value name="role" type="Int"/>
+   <value name="omniscience" type="Bool"/>
+  </schema>
+ </table>
  <table name="foo">
   <schema>
    <value name="col1" type="Int"/>