1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
exception Exception of string
type t =
{ namespace : string
; version : int
; dirty : bool
}
let create ~namespace = { namespace; version = 0; dirty = true }
let mark_dirty state = { state with dirty = true }
let mark_clean state = { state with dirty = false }
let increment state = { state with version = state.version + 1 }
let rec drop_steps steps n =
match steps, n with
| [], _ -> []
| _, n when n <= 0 -> steps
| _ :: steps, n -> drop_steps steps (n - 1)
;;
let steps_to_apply (namespace, steps) { version; _ } = namespace, drop_steps steps version
let of_tuple (namespace, version, dirty) = { namespace; version; dirty }
let to_tuple state = state.namespace, state.version, state.dirty
let dirty state = state.dirty
module Migration = struct
type step =
{ label : string
; statement : string
; check_fk : bool
}
[@@deriving show, eq]
type t = string * step list [@@deriving show, eq]
end
module Registry = struct
let registry : Migration.t list ref = ref []
let get_all () = !registry
let register migration = registry := List.concat [ !registry; [ migration ] ]
end