Commit: 972e7876e9fba5fa38161ed5a793e045db96c91d - flitter-nix (git)

A Nix-friendly SQLite-enhanced fork of Flitter, a speedrunning split timer for Unix-style terminals

Commit MetaInfo

• Revision: 972e7876e9fba5fa38161ed5a793e045db96c91d (tree)
• Time: 2023-05-23 03:12:25
• Author: Corbin <cds@corb...>
• Commiter: Corbin

Log Message

Implement the bulk of the migration.

I think I've got the data model nailed down. Aside from a couple
optional fields for datetimes, which we'll want in the future, this is
basically complete.

One of my savefiles doesn't import. It uses different split titles in
its attempts, due to rerouting. This is exactly the sort of thing I
wanted to preserve, so I'll fix it.

Change Summary

• modified: bin/migrate_main.ml
• modified: init.sql

Incremental Difference

--- a/bin/migrate_main.ml
+++ b/bin/migrate_main.ml
@@ -8,7 +8,7 @@ let usage =
 type split = { title : string; time : Duration.t }
 [@@deriving of_sexp] [@@sexp.allow_extra_fields]
 
-type run = { attempt : int; splits : split array }
+type run = { attempt : int; splits : split list }
 [@@deriving of_sexp] [@@sexp.allow_extra_fields]
 
 type old_sexp = {
@@ -19,18 +19,16 @@ type old_sexp = {
 }
 [@@deriving of_sexp] [@@sexp.allow_extra_fields]
 
-let check_exec db stmt = Rc.check (exec db stmt)
-
-let check_bind stmt vals f =
+let check_insert stmt vals =
   Rc.check (bind_values stmt vals);
-  Rc.check (iter stmt ~f)
+  Rc.check (iter stmt ~f:(fun _ -> ()))
 
 let upsert_game db sexp =
   print_string (sprintf "Title: %s Category: %s\n" sexp.title sexp.category);
   let stmt =
     prepare db "insert into \"games\" values (?) on conflict do nothing;"
   in
-  check_bind stmt [ Data.TEXT sexp.title ] (fun _ -> ())
+  check_insert stmt [ Data.TEXT sexp.title ]
 
 let upsert_checkpoints db splits =
   let stmt =
@@ -41,7 +39,7 @@ let upsert_checkpoints db splits =
     match l with
     | [] -> ()
     | next :: tail ->
-        check_bind stmt [ next; prev ] (fun _ -> ());
+        check_insert stmt [ next; prev ];
         go tail next
   in
   go (List.map ~f:(fun s -> Data.TEXT s) splits) Data.NULL
@@ -55,31 +53,81 @@ let finish_line splits =
 let insert_route db sexp =
   upsert_game db sexp;
   upsert_checkpoints db sexp.split_names;
-  let stmt = prepare db "insert into \"routes\" values (?, ?, ?, ?);" in
+  let stmt =
+    prepare db
+      "insert into \"routes\" values (?, ?, ?, ?) on conflict do nothing;"
+  in
   let finish, penult = finish_line sexp.split_names in
-  Rc.check
-    (bind_values stmt
-       [
-         Data.TEXT sexp.title;
-         Data.TEXT sexp.category;
-         Data.TEXT finish;
-         Data.opt_text penult;
-       ]);
-  Rc.is_success (iter stmt (fun _ -> ()))
+  check_insert stmt
+    [
+      Data.TEXT sexp.title;
+      Data.TEXT sexp.category;
+      Data.TEXT finish;
+      Data.opt_text penult;
+    ]
+
+let insert_segments db attempt game category splits =
+  let stmt =
+    prepare db
+      "insert into \"segments\" values (?, ?, ?, ?, ?, ?) on conflict do \
+       nothing;"
+  in
+  let rec go l (starting_at, t1) =
+    match l with
+    | [] -> ()
+    | (ending_at, t2) :: tail ->
+        check_insert stmt
+          [
+            Data.INT (Int64.of_int attempt);
+            Data.TEXT game;
+            Data.TEXT category;
+            ending_at;
+            starting_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)
+    (Data.NULL, 0)
+
+let insert_runs db sexp =
+  let stmt =
+    prepare db
+      "insert into \"runs\" values (?, ?, ?, ?, ?, ?) on conflict do nothing;"
+  in
+  List.iter
+    ~f:(fun { attempt; splits } ->
+      let f, p = finish_line (List.map ~f:(fun { title } -> title) splits) in
+      check_insert stmt
+        [
+          Data.INT (Int64.of_int attempt);
+          Data.TEXT sexp.title;
+          Data.TEXT sexp.category;
+          Data.TEXT f;
+          Data.opt_text p;
+          Data.NULL;
+        ];
+      print_string
+        (sprintf "Importing attempt %d (%s, %s)...\n" attempt
+           (Option.value p ~default:"...")
+           f);
+      insert_segments db attempt sexp.title sexp.category splits)
+    sexp.history
 
 let () =
-  match Sys.get_argv () with
-  | [| _; path; db_path |] ->
+  match Array.to_list (Sys.get_argv ()) with
+  | _ :: db_path :: scms ->
       let db = db_open db_path in
-      print_string (sqlite_version_info ());
-      print_newline ();
-      check_exec db "pragma foreign_keys = on;";
-      let sexp = Sexp.load_sexp_conv_exn path old_sexp_of_sexp in
-      print_string
-        (if insert_route db sexp then "Successfully created route!\n"
-        else
-          "This route already appears to exist and I don't want to \
-           double-count any runs by mistake.\n");
+      print_string (sqlite_version_info () ^ "\n");
+      Rc.check (exec db "pragma foreign_keys = on;");
+      List.iter
+        ~f:(fun path ->
+          let sexp = Sexp.load_sexp_conv_exn path old_sexp_of_sexp in
+          insert_route db sexp;
+          print_string "Successfully created route!\n";
+          insert_runs db sexp)
+        scms;
       let _ = db_close db in
       ()
   | _ -> print_string usage

--- a/init.sql
+++ b/init.sql
@@ -5,24 +5,28 @@ create table if not exists "games" (
 
 create table if not exists "checkpoints" (
         name text not null, previous text, primary key (name, previous));
+create index if not exists "checkpoints_name" on "checkpoints" (name);
+create index if not exists "checkpoints_previous" on "checkpoints" (previous);
 
 create table if not exists "routes" (
         game text not null, category text not null,
         finish_line text not null, penultimate text,
-        primary key (game, category),
+        primary key (game, category, finish_line, penultimate),
         foreign key (game) references "games" (title) on update cascade,
         foreign key (finish_line, penultimate) references "checkpoints" (name, previous));
 
+create table if not exists "runs" (
+        attempt int not null,
+        game text not null, category text not null,
+        finish_line text not null, penultimate text,
+        started_at datetime,
+        primary key (attempt, game, category),
+        foreign key (game, category, finish_line, penultimate) references "routes" (game, category, finish_line, penultimate) on update cascade);
+
 create table if not exists "segments" (
-        created_at datetime not null,
+        attempt int not null, game text not null, category text not null,
         ending_at text not null, starting_at text,
-        primary key (created_at),
+        duration int not null,
+        primary key (attempt, game, category, ending_at, starting_at),
+        foreign key (attempt, game, category) references "runs" (attempt, game, category),
         foreign key (ending_at, starting_at) references "checkpoints" (name, previous));
-
-create table if not exists "runs" (
-        started_at datetime not null, finished_at datetime not null,
-        game text not null, category text not null,
-        primary key (started_at, finished_at),
-        foreign key (started_at) references "segments" (created_at),
-        foreign key (finished_at) references "segments" (created_at),
-        foreign key (game, category) references "routes" (game, category) on update cascade);