add depends

src/db_image.ml

@@ -0,0 +1,162 @@
+(* 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)