type migration = { version : int; name : string; statements : string list }

let migrations =
  [
    {
      version = 1;
      name = "initial schema";
      statements =
        [
          {|CREATE TABLE IF NOT EXISTS trainee (
              id TEXT PRIMARY KEY,
              username TEXT NOT NULL UNIQUE,
              credential TEXT NOT NULL
            )|};
          {|CREATE TABLE IF NOT EXISTS active_routine (
              trainee_id TEXT PRIMARY KEY,
              routine_id TEXT NOT NULL
            )|};
          {|CREATE TABLE IF NOT EXISTS in_progress (
              trainee_id TEXT PRIMARY KEY,
              encoded TEXT NOT NULL
            )|};
          {|CREATE TABLE IF NOT EXISTS workout (
              id TEXT PRIMARY KEY,
              trainee_id TEXT NOT NULL,
              seq INTEGER NOT NULL,
              encoded TEXT NOT NULL
            )|};
          {|CREATE INDEX IF NOT EXISTS workout_by_trainee
              ON workout (trainee_id, seq DESC)|};
          (* The table Dream's sql_sessions back end expects. *)
          {|CREATE TABLE IF NOT EXISTS dream_session (
              id TEXT PRIMARY KEY,
              label TEXT NOT NULL,
              expires_at REAL NOT NULL,
              payload TEXT NOT NULL
            )|};
        ];
    };
    {
      version = 2;
      name = "subjective feedback";
      statements =
        [
          {|CREATE TABLE IF NOT EXISTS feedback (
              trainee_id TEXT NOT NULL,
              seq INTEGER NOT NULL,
              encoded TEXT NOT NULL,
              PRIMARY KEY (trainee_id, seq)
            )|};
          {|CREATE INDEX IF NOT EXISTS feedback_by_trainee
              ON feedback (trainee_id, seq DESC)|};
        ];
    };
    {
      version = 3;
      name = "application feedback";
      statements =
        [
          {|CREATE TABLE IF NOT EXISTS app_feedback (
              trainee_id TEXT NOT NULL,
              seq INTEGER NOT NULL,
              submitted_at TEXT NOT NULL,
              message TEXT NOT NULL,
              PRIMARY KEY (trainee_id, seq)
            )|};
          {|CREATE INDEX IF NOT EXISTS app_feedback_by_trainee
              ON app_feedback (trainee_id, seq DESC)|};
        ];
    };
    {
      version = 4;
      name = "application feedback votes";
      statements =
        [
          {|CREATE TABLE IF NOT EXISTS app_feedback_vote (
              feedback_trainee_id TEXT NOT NULL,
              feedback_seq INTEGER NOT NULL,
              voter_id TEXT NOT NULL,
              PRIMARY KEY (feedback_trainee_id, feedback_seq, voter_id)
            )|};
          {|CREATE INDEX IF NOT EXISTS app_feedback_vote_by_voter
              ON app_feedback_vote (voter_id)|};
        ];
    };
    {
      version = 5;
      name = "ISO 8601 UTC timestamps";
      statements =
        [
          {|DROP TABLE IF EXISTS app_feedback_vote|};
          {|DROP TABLE IF EXISTS app_feedback|};
          {|DROP TABLE IF EXISTS feedback|};
          {|DROP TABLE IF EXISTS workout|};
          {|DROP TABLE IF EXISTS in_progress|};
          {|CREATE TABLE IF NOT EXISTS in_progress (
              trainee_id TEXT PRIMARY KEY,
              encoded TEXT NOT NULL
            )|};
          {|CREATE TABLE IF NOT EXISTS workout (
              id TEXT PRIMARY KEY,
              trainee_id TEXT NOT NULL,
              seq INTEGER NOT NULL,
              encoded TEXT NOT NULL
            )|};
          {|CREATE INDEX IF NOT EXISTS workout_by_trainee
              ON workout (trainee_id, seq DESC)|};
          {|CREATE TABLE IF NOT EXISTS feedback (
              trainee_id TEXT NOT NULL,
              seq INTEGER NOT NULL,
              encoded TEXT NOT NULL,
              PRIMARY KEY (trainee_id, seq)
            )|};
          {|CREATE INDEX IF NOT EXISTS feedback_by_trainee
              ON feedback (trainee_id, seq DESC)|};
          {|CREATE TABLE IF NOT EXISTS app_feedback (
              trainee_id TEXT NOT NULL,
              seq INTEGER NOT NULL,
              submitted_at TEXT NOT NULL,
              message TEXT NOT NULL,
              PRIMARY KEY (trainee_id, seq)
            )|};
          {|CREATE INDEX IF NOT EXISTS app_feedback_by_trainee
              ON app_feedback (trainee_id, seq DESC)|};
          {|CREATE TABLE IF NOT EXISTS app_feedback_vote (
              feedback_trainee_id TEXT NOT NULL,
              feedback_seq INTEGER NOT NULL,
              voter_id TEXT NOT NULL,
              PRIMARY KEY (feedback_trainee_id, feedback_seq, voter_id)
            )|};
          {|CREATE INDEX IF NOT EXISTS app_feedback_vote_by_voter
              ON app_feedback_vote (voter_id)|};
        ];
    };
    {
      version = 6;
      name = "five-point feedback scores";
      (* Subjective feedback now encodes levels as scores 1..5, so rows written
         with the old below/usual/above codes no longer decode. Feedback is
         observed, not authored, so the domain permits dropping it rather than
         migrating it. *)
      statements =
        [
          {|DROP TABLE IF EXISTS feedback|};
          {|CREATE TABLE IF NOT EXISTS feedback (
              trainee_id TEXT NOT NULL,
              seq INTEGER NOT NULL,
              encoded TEXT NOT NULL,
              PRIMARY KEY (trainee_id, seq)
            )|};
          {|CREATE INDEX IF NOT EXISTS feedback_by_trainee
              ON feedback (trainee_id, seq DESC)|};
        ];
    };
  ]

(* The ledger of applied migrations. A row per version, so a reconnect knows
   what the file already carries and skips it. *)
let ledger =
  {|CREATE TABLE IF NOT EXISTS schema_migrations (
      version INTEGER PRIMARY KEY,
      name TEXT NOT NULL,
      applied_at REAL NOT NULL
    )|}

let statements =
  List.concat_map (fun migration -> migration.statements) migrations

(* --- request helpers --- *)

let exec_sql (module Db : Caqti_lwt.CONNECTION) sql =
  let request =
    let open Caqti_request.Infix in
    let open Caqti_type.Std in
    (unit ->. unit) ~oneshot:true sql
  in
  Db.exec request ()

let is_applied (module Db : Caqti_lwt.CONNECTION) version =
  let request =
    let open Caqti_request.Infix in
    let open Caqti_type.Std in
    (int ->! int) ~oneshot:true
      "SELECT COUNT(*) FROM schema_migrations WHERE version = ?"
  in
  Db.find request version

let record_applied (module Db : Caqti_lwt.CONNECTION) migration =
  let request =
    let open Caqti_request.Infix in
    let open Caqti_type.Std in
    (t2 int string ->. unit)
      ~oneshot:true
      "INSERT INTO schema_migrations (version, name, applied_at) VALUES (?, ?, \
       strftime('%s','now'))"
  in
  Db.exec request (migration.version, migration.name)

(* Apply one migration inside a transaction, then record it. The ledger check
   makes this idempotent; the [IF NOT EXISTS] clauses keep an already-populated
   file from a pre-ledger build safe. *)
let apply_migration ((module Db : Caqti_lwt.CONNECTION) as db) migration =
  let open Lwt_result.Syntax in
  let* applied = is_applied db migration.version in
  if applied > 0 then Lwt_result.return ()
  else
    Db.with_transaction (fun () ->
        let rec go = function
          | [] -> record_applied db migration
          | sql :: tl ->
              let* () = exec_sql db sql in
              go tl
        in
        go migration.statements)

let apply (module Db : Caqti_lwt.CONNECTION) =
  let db = (module Db : Caqti_lwt.CONNECTION) in
  let open Lwt_result.Syntax in
  let run =
    let* () = exec_sql db ledger in
    let rec go = function
      | [] -> Lwt_result.return ()
      | migration :: tl ->
          let* () = apply_migration db migration in
          go tl
    in
    go migrations
  in
  Lwt.map
    (function Ok () -> Ok () | Error e -> Error (e :> Caqti_error.t))
    run