add support TTL_JOB_INTERVAL in ALTER TABLE

lib/sql.ml

@@ -987,7 +987,8 @@ type charset_name = Named of string | Binary | Ascii | Unicode
 
 type ttl_option =
   [ `TtlSet of string * int * string
-  | `TtlEnable of string ] [@@deriving show {with_path=false}]
+  | `TtlEnable of string
+  | `TtlJobInterval of string ] [@@deriving show {with_path=false}]
 
 module Alter_column_pg = struct
   type t =

lib/sql_lexer.mll

@@ -196,6 +196,7 @@ let keywords =
    "recursive", RECURSIVE;
    "ttl", TTL;
    "ttl_enable", TTL_ENABLE;
+   "ttl_job_interval", TTL_JOB_INTERVAL;
    "remove", REMOVE;
    "type", TYPE "type";
   ] in (* more *)

lib/sql_parser.mly

@@ -44,7 +44,7 @@
        FIRST_VALUE LAST_VALUE NTH_VALUE PARTITION ROWS RANGE UNBOUNDED PRECEDING FOLLOWING CURRENT ROW
        CAST GENERATED ALWAYS VIRTUAL STORED STATEMENT DOUBLECOLON QSTN TWO_QSTN INSTANT INPLACE COPY ALGORITHM RECURSIVE
        SHARED EXCLUSIVE NONE
-       TTL TTL_ENABLE REMOVE
+       TTL TTL_ENABLE TTL_JOB_INTERVAL REMOVE
 %token FUNCTION PROCEDURE LANGUAGE RETURNS OUT INOUT BEGIN COMMENT
 %token SECOND_MICROSECOND MINUTE_MICROSECOND MINUTE_SECOND
        HOUR_MICROSECOND HOUR_SECOND HOUR_MINUTE
@@ -400,6 +400,7 @@ alter_action_or_ignored: a=alter_action { Some a }
 ttl_option: TTL EQUAL col=ident PLUS INTERVAL n=INTEGER unit=INTERVAL_UNIT
               { `TtlSet (col, n, unit) }
           | TTL_ENABLE EQUAL v=TEXT { `TtlEnable v }
+          | TTL_JOB_INTERVAL EQUAL v=TEXT { `TtlJobInterval v }
 index_or_key: INDEX | KEY { }
 index_type:
   | index_or_key { Sql.Plain_idx }

lib/syntax.ml

@@ -1680,20 +1680,26 @@ let rec eval (stmt:Sql.stmt) =
         Tables.index_rename name ~old_name ~new_name
       | `AddConstraint _ | `DropConstraint _ -> ()
       | `TtlOptions (opts, _) ->
-        let expr, enabled =
-          List.fold_left (fun (expr, enabled) -> function
-            | `TtlSet (col, n, unit) -> Some (col, n, String.uppercase_ascii unit), enabled
-            | `TtlEnable v -> expr, Some (String.uppercase_ascii v <> "OFF"))
-            (None, None) opts
+        let expr, enabled, job_interval =
+          List.fold_left (fun (expr, enabled, job_interval) -> function
+            | `TtlSet (col, n, unit) -> Some (col, n, String.uppercase_ascii unit), enabled, job_interval
+            | `TtlEnable v -> expr, Some (String.uppercase_ascii v <> "OFF"), job_interval
+            | `TtlJobInterval v -> expr, enabled, Some v)
+            (None, None, None) opts
         in
         let prev = Tables.get_ttl name in
         let ttl_enabled =
           Option.default (Option.map_default (fun (t : Tables.table_ttl) -> t.ttl_enabled) true prev) enabled
         in
+        let ttl_job_interval =
+          match job_interval with
+          | Some _ -> job_interval
+          | None -> Option.map_default (fun (t : Tables.table_ttl) -> t.ttl_job_interval) None prev
+        in
         Tables.set_ttl name @@
           Option.map_default
-            (fun (ttl_col, ttl_n, ttl_unit) -> Some { Tables.ttl_col; ttl_n; ttl_unit; ttl_enabled })
-            (Option.map (fun (t : Tables.table_ttl) -> { t with ttl_enabled }) prev)
+            (fun (ttl_col, ttl_n, ttl_unit) -> Some { Tables.ttl_col; ttl_n; ttl_unit; ttl_enabled; ttl_job_interval })
+            (Option.map (fun (t : Tables.table_ttl) -> { t with ttl_enabled; ttl_job_interval }) prev)
             expr
       | `RemoveTtl _ -> Tables.set_ttl name None
       | `Default_or_convert_to (cs, collation) ->

lib/tables.ml

@@ -14,7 +14,7 @@ type table = Sql.table
 
 type table_charset = { charset : Sql.charset_name; collation : string option }
 
-type table_ttl = { ttl_col : string; ttl_n : int; ttl_unit : string; ttl_enabled : bool }
+type table_ttl = { ttl_col : string; ttl_n : int; ttl_unit : string; ttl_enabled : bool; ttl_job_interval : string option }
 
 module SMap = Map.Make(String)
 

src/gen_migrations.ml

@@ -156,7 +156,8 @@ let action_to_sql_fragment ~default_sql_lookup (action : Sql.alter_action) = mat
     |> List.map (function
       | `TtlSet (col, n, unit) ->
         sprintf "TTL = %s + INTERVAL %d %s" (quote_id col) n (String.uppercase_ascii unit)
-      | `TtlEnable v -> sprintf "TTL_ENABLE = '%s'" v)
+      | `TtlEnable v -> sprintf "TTL_ENABLE = '%s'" v
+      | `TtlJobInterval v -> sprintf "TTL_JOB_INTERVAL = '%s'" v)
     |> String.concat " "
   | `RemoveTtl _ -> "REMOVE TTL"
   | `AlterColumnPG (col_name, change) ->

src/schema_diff.ml

@@ -191,6 +191,7 @@ let diff_charset =
 let ttl_options_of (t : Tables.table_ttl) =
   [ `TtlSet (t.ttl_col, t.ttl_n, t.ttl_unit);
     `TtlEnable (if t.ttl_enabled then "ON" else "OFF") ]
+  @ Option.map_default (fun v -> [`TtlJobInterval v]) [] t.ttl_job_interval
 
 let diff_ttl =
   diff_property (fun t -> t.Tables.tbl_ttl)
@@ -280,6 +281,11 @@ let invert ~by_from ~by_to up =
       if f.Tables.tbl_charset = None && t.Tables.tbl_charset <> None then
         irreversible "a DEFAULT CHARSET / COLLATE was added while the baseline has \
                       no explicit charset to restore"
+      else if (match f.Tables.tbl_ttl, t.Tables.tbl_ttl with
+        | Some { Tables.ttl_job_interval = None; _ }, Some { Tables.ttl_job_interval = Some _; _ } -> true
+        | _ -> false) then
+        irreversible "a TTL_JOB_INTERVAL was added while the baseline has no \
+                      explicit value to restore"
       else
         match alter_change name f (diff_table ~from_:t ~to_:f) with
         | Some down -> down
@@ -308,8 +314,8 @@ let canonical ts =
   in
   let ttl_sig =
     Option.map_default
-      (fun ({ ttl_col; ttl_n; ttl_unit; ttl_enabled } : Tables.table_ttl) ->
-        sprintf "%s+%d %s/%s" ttl_col ttl_n ttl_unit (if ttl_enabled then "on" else "off"))
+      (fun ({ ttl_col; ttl_n; ttl_unit; ttl_enabled; ttl_job_interval } : Tables.table_ttl) ->
+        sprintf "%s+%d %s/%s/%s" ttl_col ttl_n ttl_unit (if ttl_enabled then "on" else "off") (Option.default "" ttl_job_interval))
       ""
   in
   let table_sig (t : Tables.stored_table) =

test/cram/test.t

@@ -3589,6 +3589,22 @@ TTL is rejected on non-TiDB dialects:
   Errors encountered, no code generated
   [1]
 
+TTL_JOB_INTERVAL is accepted on TiDB, standalone or with other TTL options:
+  $ sqlgg -gen caml -no-header -dialect=tidb - <<'EOF' >/dev/null
+  > CREATE TABLE foo (id INT NOT NULL, created_at TIMESTAMP NOT NULL);
+  > ALTER TABLE foo TTL = `created_at` + INTERVAL 6 MONTH TTL_ENABLE = 'ON' TTL_JOB_INTERVAL = '24h';
+  > ALTER TABLE foo TTL_JOB_INTERVAL = '30m';
+  > EOF
+
+TTL_JOB_INTERVAL is rejected on non-TiDB dialects:
+  $ sqlgg -gen caml -no-header -dialect=mysql - <<'EOF' 2>&1
+  > CREATE TABLE foo (id INT NOT NULL, created_at TIMESTAMP NOT NULL);
+  > ALTER TABLE foo TTL_JOB_INTERVAL = '30m';
+  > EOF
+  Feature Ttl is not supported for dialect MySQL (supported by: TiDB) at TTL_JOB_INTERVAL = '30m'
+  Errors encountered, no code generated
+  [1]
+
 Composite: a choice nested inside another choice — every level is wrapped
 independently, so precedence is protected at each depth:
   $ sqlgg -gen caml -params unnamed -no-header - <<'EOF' 2>&1 | grep -F 'WHERE FALSE AND' | head -1