From 9c769ae9472a908fb636fe9f949958f8f36efa8e Mon Sep 17 00:00:00 2001
From: Swrup <swrup@protonmail.com>
Date: Sat, 31 Dec 2022 06:01:03 +0100
Subject: [PATCH] emojid: use trie

---
 src/babillard.ml |   4 +-
 src/dune         |   1 +
 src/emojid.ml    | 111 +++++++++++++++++++++++++++--------------------
 src/emojid.mli   |   5 +++
 4 files changed, 71 insertions(+), 50 deletions(-)
 create mode 100644 src/emojid.mli

diff --git a/src/babillard.ml b/src/babillard.ml
index c7ebf58..c139782 100644
--- a/src/babillard.ml
+++ b/src/babillard.ml
@@ -295,7 +295,7 @@ let build_reply ~comment ~image_info ~tag_list ?parent_id user_id =
     let date = Unix.time () in
     let comment, citations = parse_comment comment in
     let* nick = User.get_nick user_id in
-    let* emojid = Emojid.make_emojid id in
+    let* emojid = Emojid.make id in
     let reply =
       { id
       ; emojid
@@ -356,7 +356,7 @@ let make_post ~comment ?image_input ~tags ~op_or_reply_data user_id =
 let post_exist id = Result.is_ok (Q.get_is_post id)
 
 let get_post id =
-  let* emojid = Emojid.Q.get_emojid id in
+  let* emojid = Emojid.get id in
   let* parent_id = Q.get_post_thread id in
   let* user_id = Q.get_post_user_id id in
   let* nick = User.get_nick user_id in
diff --git a/src/dune b/src/dune
index eef9d6c..9958048 100644
--- a/src/dune
+++ b/src/dune
@@ -31,6 +31,7 @@
   conan
   conan.string
   conan-database.light
+  containers-data
   directories
   dream
   emile
diff --git a/src/emojid.ml b/src/emojid.ml
index 919c2a5..8691e53 100644
--- a/src/emojid.ml
+++ b/src/emojid.ml
@@ -2,21 +2,48 @@ open Syntax
 open Caqti_request.Infix
 open Caqti_type
 
+(* todo better: make emojid just string and not string list in this module;
+   problem is we have to split on unicode *)
+
 module Q = struct
-  let upload_emojid =
+  (* we save emojid in a string with emoji separated by '-' *)
+  let upload_emojid uuid emojid =
+    let emojid = String.concat "-" emojid in
     Db.exec
-    @@ (tup2 string string ->. unit) "INSERT INTO uuid_emojid VALUES (?,?)"
+      ((tup2 string string ->. unit) "INSERT INTO uuid_emojid VALUES (?,?)")
+      (uuid, emojid)
 
-  let get_emojid =
-    Db.find @@ (string ->! string) "SELECT emojid FROM uuid_emojid WHERE uuid=?"
-
-  let is_free =
+  let get_emojid uuid =
     Db.find
-    @@ (string ->! int)
-         "SELECT EXISTS(SELECT 1 FROM uuid_emojid WHERE emojid=?)"
+      ((string ->! string) "SELECT emojid FROM uuid_emojid WHERE uuid=?")
+      uuid
+    |> Result.map (String.split_on_char '-')
+
+  let get_all_emojid () =
+    let* l =
+      Db.collect_list ((unit ->* string) "SELECT emojid FROM uuid_emojid") ()
+    in
+    Ok (List.map (String.split_on_char '-') l)
 end
 
-let () =
+module Trie = CCTrie.Make (struct
+  type t = string list
+
+  type char_ = string
+
+  let compare = String.compare
+
+  let to_iter o f = List.iter f o
+
+  let of_list = Fun.id
+end)
+
+let max_emojid_lenght = 16
+
+let alphabet =
+  Array.append Emoji.category_animals_and_nature Emoji.category_food_and_drink
+
+let trie =
   let tables =
     [| (unit ->. unit)
          "CREATE TABLE IF NOT EXISTS uuid_emojid (uuid TEXT, emojid TEXT)"
@@ -25,47 +52,35 @@ let () =
   if
     Array.exists Result.is_error
       (Array.map (fun query -> Db.exec query ()) tables)
-  then Dream.error (fun log -> log "can't create emojid's tables")
+  then failwith "can't create emojid's tables"
+  else
+    match Q.get_all_emojid () with
+    | Error e ->
+      failwith (Format.sprintf "Error with Emojid.Q.select_all: %s" e)
+    | Ok l ->
+      let l = List.map (fun e -> (e, ())) l in
+      ref (Trie.of_list l)
 
-let max_emojid_lenght = 16
-
-let emojis =
-  Array.append Emoji.category_animals_and_nature Emoji.category_food_and_drink
-
-let is_free emojid =
-  let* is_free = Q.is_free emojid in
-  Ok (is_free = 0)
-
-let upload_emojid uuid emojid =
-  let* is_free = is_free emojid in
-  if is_free then
-    let* () = Q.upload_emojid (uuid, emojid) in
-    Ok ()
-  else Error "Invalid emojid: already taken"
-
-let make_emojid uuid =
+let make uuid =
   (* pick a list of emojis *)
   let random_emojis =
-    Array.init max_emojid_lenght (fun _i ->
-        let n = Random.int (Array.length emojis) in
-        Array.get emojis n )
+    List.init max_emojid_lenght (fun _i ->
+        let n = Random.int (Array.length alphabet) in
+        Array.get alphabet n )
   in
   (* pick the smallest emojid possible *)
-  let* emojid, is_emojid =
-    Array.fold_left
-      (fun acc emoji ->
-        match acc with
-        | Error e -> Error e
-        | Ok (s, is_emojid) ->
-          if is_emojid then Ok (s, is_emojid)
-          else
-            let s = s ^ emoji in
-            let* is_emojid = is_free s in
-            Ok (s, is_emojid) )
-      (Ok ("", false))
-      random_emojis
-  in
-  if is_emojid then
-    let* () = upload_emojid uuid emojid in
-    Ok emojid
-  else Error "couldn't find a free emojid"
+  let longest_prefix = Trie.longest_prefix random_emojis !trie in
+  (* add one more emoji to longest_prefix *)
+  match List.nth_opt random_emojis (List.length longest_prefix) with
+  | None ->
+    Dream.error (fun log -> log "Emojid error: longest prefix is too long");
+    Error "Could not create emojid"
+  | Some x ->
+    let emojid = longest_prefix @ [ x ] in
+    let* () = Q.upload_emojid uuid emojid in
+    trie := Trie.add emojid () !trie;
+    Ok (String.concat "" emojid)
+
+let get uuid =
+  let* l = Q.get_emojid uuid in
+  Ok (String.concat "" l)
diff --git a/src/emojid.mli b/src/emojid.mli
new file mode 100644
index 0000000..664874c
--- /dev/null
+++ b/src/emojid.mli
@@ -0,0 +1,5 @@
+(** [make uuid] creates an emojid for [uuid]; hopefully returns [Ok emojid] *)
+val make : string -> (string, string) result
+
+(** [get uuid] is [Ok emoji] if [uuid] has an emojid *)
+val get : string -> (string, string) result