(* TODO - delete: error if does not exists - better upload (insert/update) - use join *) open Syntax open Err open Types open Caqti_request.Infix open Caqti_type open Caqti_db let post_tbl_prefix, post_key_reference = ("post_", "post(id)") let avatar_tbl_prefix, avatar_key_reference = ("user_", "user(user_id)") let () = let mk_tables id_kind prefix reference_tbl = [| Fmt.kstr (unit ->. unit) "CREATE TABLE IF NOT EXISTS %simage_info (id %s, md5 TEXT, mime TEXT, \ w INTEGER, h INTEGER, thumb_w INTEGER, thumb_h INTEGER, name TEXT, \ alt TEXT, FOREIGN KEY(id) REFERENCES %s ON DELETE CASCADE)" prefix id_kind reference_tbl ; Fmt.kstr (unit ->. unit) "CREATE TABLE IF NOT EXISTS %simage_content (id %s, content TEXT, \ FOREIGN KEY(id) REFERENCES %s ON DELETE CASCADE)" prefix id_kind reference_tbl ; Fmt.kstr (unit ->. unit) "CREATE TABLE IF NOT EXISTS %simage_thumbnail (id %s, content TEXT, \ FOREIGN KEY(id) REFERENCES %s ON DELETE CASCADE)" prefix id_kind reference_tbl |] in let tables = Array.concat [ mk_tables "INTEGER" post_tbl_prefix post_key_reference ; mk_tables "TEXT" avatar_tbl_prefix avatar_key_reference ] in Array.iter (fun query -> Db.exec_unsafe query ()) tables module type T = sig type t val info : t -> img_info option result val data : t -> string option result val thumbnail_data : t -> string option result val delete : t -> unit result val upload : t -> img -> unit result end module type A = sig type t val caqti_t : t Caqti_type.t val prefix : string val replace_image : bool end (* Make(A) => T *) module Make (M : A) = struct include M let upload_info = Db.exec @@ Fmt.kstr (t9 caqti_t string string int int int int string string ->. unit) "INSERT INTO %simage_info VALUES (?,?,?,?,?,?,?,?,?)" prefix let upload_data = Db.exec @@ Fmt.kstr (t2 caqti_t string ->. unit) "INSERT INTO %simage_content VALUES (?,?)" prefix let upload_thumbnail_data = Db.exec @@ Fmt.kstr (t2 caqti_t string ->. unit) "INSERT INTO %simage_thumbnail VALUES (?,?)" prefix let info = let f = Db.find_opt (Fmt.kstr (caqti_t ->? t9 caqti_t string string int int int int string string) "SELECT * FROM %simage_info WHERE id=?" prefix ) in fun id -> let+ opt = f id in Option.map (fun (_id, md5, mime, w, h, thumb_w, thumb_h, name, alt) -> { md5; mime; w; h; thumb_w; thumb_h; name; alt } ) opt let data = Db.find_opt @@ Fmt.kstr (caqti_t ->? string) "SELECT content FROM %simage_content WHERE id=?" prefix let thumbnail_data = Db.find_opt @@ Fmt.kstr (caqti_t ->? string) "SELECT content FROM %simage_thumbnail WHERE id=?" prefix let delete_info = Db.exec @@ Fmt.kstr (caqti_t ->. unit) "DELETE FROM %simage_info WHERE id=?" prefix let delete_content = Db.exec @@ Fmt.kstr (caqti_t ->. unit) "DELETE FROM %simage_content WHERE id=?" prefix let delete_thumbnail = Db.exec @@ Fmt.kstr (caqti_t ->. unit) "DELETE FROM %simage_thumbnail WHERE id=?" prefix (* TODO error if does not exists *) let delete id = let* () = delete_info id in let* () = delete_content id in delete_thumbnail id let upload id image = (* TODO do something like https://stackoverflow.com/questions/418898/upsert-not-insert-or-replace/4330694#4330694 instead of deleting then re-inserting to update(or insert on first time).. *) let* () = if replace_image then delete id else Ok () in (* -- *) let { info; data; thumbnail_data } = image in let { md5; mime; w; h; thumb_w; thumb_h; name; alt } = info in let* () = upload_info (id, md5, mime, w, h, thumb_w, thumb_h, name, alt) in let* () = upload_data (id, data) in upload_thumbnail_data (id, thumbnail_data) end module P = Make (struct type t = int let caqti_t = Caqti_type.int let prefix = post_tbl_prefix let replace_image = false end) module U = Make (struct type t = string let caqti_t = Caqti_type.string let prefix = avatar_tbl_prefix let replace_image = true end)