72 lines
1.8 KiB
OCaml
72 lines
1.8 KiB
OCaml
|
|
open Syntax
|
||
|
|
open Caqti_request.Infix
|
||
|
|
open Caqti_type
|
||
|
|
|
||
|
|
module Q = struct
|
||
|
|
let upload_emojid =
|
||
|
|
Db.exec
|
||
|
|
@@ (tup2 string string ->. unit) "INSERT INTO uuid_emojid VALUES (?,?)"
|
||
|
|
|
||
|
|
let get_emojid =
|
||
|
|
Db.find @@ (string ->! string) "SELECT emojid FROM uuid_emojid WHERE uuid=?"
|
||
|
|
|
||
|
|
let is_free =
|
||
|
|
Db.find
|
||
|
|
@@ (string ->! int)
|
||
|
|
"SELECT EXISTS(SELECT 1 FROM uuid_emojid WHERE emojid=?)"
|
||
|
|
end
|
||
|
|
|
||
|
|
let () =
|
||
|
|
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 Dream.error (fun log -> log "can't create emojid's tables")
|
||
|
|
|
||
|
|
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 =
|
||
|
|
(* 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 )
|
||
|
|
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"
|