Flitterite

Fork

open Core
open Sqlite3

let usage =
  "Usage:\n" ^ "flitter-migrate <splits_path> <db>\n"
  ^ "Import S-expression split files to a SQLite database.\n"

type split = { title : string; time : Duration.t }
[@@deriving of_sexp] [@@sexp.allow_extra_fields]

type run = { attempt : int; splits : split list }
[@@deriving of_sexp] [@@sexp.allow_extra_fields]

type old_sexp = {
  title : string;
  category : string;
  split_names : string list;
  history : run list; [@sexp.omit_nil]
}
[@@deriving of_sexp] [@@sexp.allow_extra_fields]

let upsert_game db sexp =
  print_string (sprintf "Title: %s Category: %s\n" sexp.title sexp.category);
  let stmt =
    Storage.prep db "insert into \"games\" values (?) on conflict do nothing;"
  in
  Storage.check_insert stmt [ Data.TEXT sexp.title ]

let new_game = Data.TEXT "New Game"

let upsert_checkpoints db splits =
  let stmt =
    Storage.prep db
      "insert into \"checkpoints\" values (?, ?) on conflict do nothing;"
  in
  let rec go l prev =
    match l with
    | [] -> ()
    | next :: tail ->
        Storage.check_insert stmt [ next; prev ];
        go tail next
  in
  go (List.map ~f:(fun s -> Data.TEXT s) splits) new_game

let finish_line splits =
  match List.rev splits with
  | [] -> failwith "Routes need at least one named split: the finish line!"
  | s :: _ -> s

let insert_route db sexp =
  upsert_game db sexp;
  upsert_checkpoints db sexp.split_names;
  let stmt =
    Storage.prep db
      "insert into \"routes\" values (?, ?, ?, ?) on conflict do nothing;"
  in
  let finish = finish_line sexp.split_names in
  Storage.check_insert stmt
    [
      Data.TEXT sexp.title; Data.TEXT sexp.category; new_game; Data.TEXT finish;
    ]

let insert_segments db attempt game category splits =
  let stmt =
    Storage.prep db
      "insert into \"segments\" values (?, ?, ?, ?, ?, ?) on conflict do \
       nothing;"
  in
  let rec go l (starting_at, t1) =
    match l with
    | [] -> ()
    | (ending_at, t2) :: tail ->
        Storage.check_insert stmt
          [
            Data.INT (Int64.of_int attempt);
            Data.TEXT game;
            Data.TEXT category;
            starting_at;
            ending_at;
            Data.INT (Int64.of_int (t2 - t1));
          ];
        go tail (ending_at, t2)
  in
  go
    (List.map ~f:(fun { title; time } -> (Data.TEXT title, time)) splits)
    (new_game, 0)

let insert_runs db sexp =
  let stmt =
    Storage.prep db
      "insert into \"runs\" values (?, ?, ?, ?, ?, ?) on conflict do nothing;"
  in
  List.iter
    ~f:(fun { attempt; splits } ->
      let split_names = List.map ~f:(fun { title } -> title) splits in
      let finish = finish_line split_names in
      upsert_checkpoints db split_names;
      Storage.check_insert stmt
        [
          Data.INT (Int64.of_int attempt);
          Data.TEXT sexp.title;
          Data.TEXT sexp.category;
          new_game;
          Data.TEXT finish;
          Data.NULL;
        ];
      insert_segments db attempt sexp.title sexp.category splits)
    sexp.history;
  print_string (sprintf "Imported %d attempts\n" (List.length sexp.history))

let () =
  match Array.to_list (Sys.get_argv ()) with
  | _ :: db_path :: scms ->
      Storage.with_db db_path (fun db ->
          List.iter
            ~f:(fun path ->
              let sexp = Sexp.load_sexp_conv_exn path old_sexp_of_sexp in
              insert_route db sexp;
              insert_runs db sexp)
            scms)
  | _ -> print_string usage