geochan/src/emojid.ml
2022-12-31 06:11:41 +01:00

86 lines
2.3 KiB
OCaml

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
(* 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 (?,?)")
(uuid, emojid)
let get_emojid uuid =
Db.find
((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
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)"
|]
in
if
Array.exists Result.is_error
(Array.map (fun query -> Db.exec query ()) 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 make uuid =
(* pick a list of emojis *)
let random_emojis =
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 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)