2021-03-10 09:50:15 +00:00
|
|
|
(* Grej is utilities *)
|
2021-10-20 09:10:43 +00:00
|
|
|
module Syntax = struct
|
2022-04-04 16:30:21 +00:00
|
|
|
open Caqti_request.Infix
|
2021-10-20 09:10:43 +00:00
|
|
|
let ( let* ) = Result.bind
|
|
|
|
let ( let+ ) x f = Result.map f x
|
2022-04-04 16:30:21 +00:00
|
|
|
let ( ->. ) = ( ->. ) ~oneshot:true
|
|
|
|
let ( ->! ) = ( ->! ) ~oneshot:true
|
|
|
|
let ( ->? ) = ( ->? ) ~oneshot:true
|
|
|
|
let ( ->* ) = ( ->* ) ~oneshot:true
|
2021-10-20 09:10:43 +00:00
|
|
|
end
|
|
|
|
|
|
|
|
module Infix = struct
|
2022-04-04 16:30:21 +00:00
|
|
|
open Caqti_request.Infix
|
2021-10-20 09:10:43 +00:00
|
|
|
let ( >>= ) = Result.bind
|
|
|
|
let ( >>| ) x f = Result.map f x
|
2022-04-04 16:30:21 +00:00
|
|
|
let ( ->. ) = ( ->. ) ~oneshot:true
|
|
|
|
let ( ->! ) = ( ->! ) ~oneshot:true
|
|
|
|
let ( ->? ) = ( ->? ) ~oneshot:true
|
|
|
|
let ( ->* ) = ( ->* ) ~oneshot:true
|
2021-10-20 09:10:43 +00:00
|
|
|
end
|
|
|
|
|
|
|
|
open Syntax
|
2021-03-10 09:50:15 +00:00
|
|
|
|
|
|
|
let set_version version =
|
2022-04-04 16:30:21 +00:00
|
|
|
Caqti_type.unit ->. Caqti_type.unit @@
|
|
|
|
Printf.sprintf "PRAGMA user_version = %Ld" version
|
2021-03-10 09:50:15 +00:00
|
|
|
|
|
|
|
let check_version
|
|
|
|
?application_id:(desired_application_id=Builder_db.application_id)
|
|
|
|
~user_version:desired_user_version
|
|
|
|
(module Db : Caqti_blocking.CONNECTION) =
|
2021-10-20 09:10:43 +00:00
|
|
|
let* application_id = Db.find Builder_db.get_application_id () in
|
|
|
|
let* user_version = Db.find Builder_db.get_version () in
|
2021-03-10 09:50:15 +00:00
|
|
|
if application_id <> desired_application_id || user_version <> desired_user_version
|
|
|
|
then Error (`Wrong_version (application_id, user_version))
|
|
|
|
else Ok ()
|
|
|
|
|
2021-03-12 08:47:28 +00:00
|
|
|
let list_iter_result f xs =
|
|
|
|
List.fold_left
|
2021-10-20 09:10:43 +00:00
|
|
|
(fun r x -> let* () = r in f x)
|
2021-03-12 08:47:28 +00:00
|
|
|
(Ok ())
|
|
|
|
xs
|
2021-06-10 10:08:14 +00:00
|
|
|
|
|
|
|
let foreign_keys on =
|
|
|
|
let on = if on then "ON" else "OFF" in
|
2022-04-04 16:30:21 +00:00
|
|
|
Caqti_type.unit ->. Caqti_type.unit @@
|
|
|
|
Printf.sprintf "PRAGMA foreign_keys = %s" on
|