From 61736756776206bd5f17a4827687630ee928417a Mon Sep 17 00:00:00 2001
From: Peter McGoron <code@mcgoron.com>
Date: Sun, 8 Aug 2021 23:29:37 -0400
Subject: [PATCH] makedb: make cached automaton

---
 dune      |  2 +-
 makedb.ml | 44 +++++++++++++++++++++++++++++++++++++-------
 2 files changed, 38 insertions(+), 8 deletions(-)

diff --git a/dune b/dune
index 7a62cc2..df210fb 100644
--- a/dune
+++ b/dune
@@ -1,5 +1,5 @@
 (executable
  (name elements)
  (modules Elements Makedb)
- (libraries sqlite3 yojson)
+ (libraries sqlite3 yojson batch_jaro_winkler)
 )
diff --git a/makedb.ml b/makedb.ml
index 5773951..ef338af 100644
--- a/makedb.ml
+++ b/makedb.ml
@@ -29,11 +29,15 @@ let allstep stmt = let open Sqlite3 in
 	let rec f = function
 	| Rc.ROW -> f (step stmt)
 	| x -> Rc.check x
-	in f (step stmt); reset stmt |> Rc.check
+	in
+	f (step stmt);
+	reset stmt |> Rc.check
 
 (** Initializes [db] from [json]. *)
 let makedb db json = let open Sqlite3
 	in let () = exec db inits |> Rc.check
+	in let symbs = ref []
+	in let names = ref []
 	in let colarr = toarr json
 	in let stmt = "INSERT INTO elements \
 		(num, symb, name, mass, cpk_color, e_config, e_neg, \
@@ -46,13 +50,39 @@ let makedb db json = let open Sqlite3
 		:MeltingPoint, :BoilingPoint, :Density, :GroupBlock, \
 		:YearDiscovered);"
 	|> prepare db
+
+	in let binds stmt s v = bind_name stmt (":" ^ s) v |> Rc.check
+
+	(* Bind each column name. In SQLite3 the leading ":" is part
+	of the named parameter. *)
 	in let prep i x =
-		bind_name stmt (":" ^ colarr.(i))
-		(if x = "" then Data.NULL else Data.TEXT x) |> Rc.check
+		(match colarr.(i) with
+		| "Symbol" -> symbs := (x,None)::!symbs
+		| "Name" -> names := (x,None)::!names
+		| _ -> ()
+		);
+		binds stmt colarr.(i)
+		    (if x = "" then Data.NULL else Data.TEXT x)
+
+	(* Cache fuzzy matching automaton. *)
+	in let do_model name vals =
+		let stmt = "INSERT INTO cache VALUES (:name, :cache);"
+		|> prepare db
+		in let open Batch_jaro_winkler
+		in let model = build_exportable_model
+			~encoding:Encoding.UTF8 vals
+		in
+		binds stmt "name" (Data.TEXT name);
+		binds stmt "cache" (Data.TEXT model);
+		allstep stmt;
+		finalize stmt |> Rc.check
+
 	in let open Yojson.Basic.Util
 	in let access_data x = x |> member "Cell" |> to_list
-		|> filter_string |> List.iteri prep; allstep stmt
-	in
-	json |> member "Table" |> member "Row" |> to_list
+		|> filter_string |> List.iteri prep;
+		allstep stmt
+	in json |> member "Table" |> member "Row" |> to_list
 		|> List.iter access_data;
-	finalize stmt |> Rc.check
+		finalize stmt |> Rc.check;
+	do_model "symbs" !symbs;
+	do_model "names" !names