put all image stuff in image.ml, make thumbnail for avatars
This commit is contained in:
parent
dbc2139511
commit
9ca17a8840
7 changed files with 240 additions and 186 deletions
106
src/babillard.ml
106
src/babillard.ml
|
|
@ -36,13 +36,6 @@ type post =
|
|||
; citations : string list
|
||||
}
|
||||
|
||||
type image =
|
||||
{ name : string
|
||||
; alt : string
|
||||
; content : string
|
||||
; thumbnail : string
|
||||
}
|
||||
|
||||
type t =
|
||||
| Op of thread_data * post
|
||||
| Post of post
|
||||
|
|
@ -90,22 +83,6 @@ module Q = struct
|
|||
"CREATE TABLE IF NOT EXISTS post_comment (post_id TEXT, comment TEXT, \
|
||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
|
||||
|
||||
let create_image_info_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS image_info (post_id TEXT, image_name TEXT, \
|
||||
image_alt TEXT, FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON \
|
||||
DELETE CASCADE);"
|
||||
|
||||
let create_image_content_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS image_content (post_id TEXT, content TEXT, \
|
||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
|
||||
|
||||
let create_image_thumbnail_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS image_thumbnail (post_id TEXT, content TEXT, \
|
||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
|
||||
|
||||
let create_post_tags_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS post_tags (post_id TEXT, tag TEXT, FOREIGN \
|
||||
|
|
@ -146,21 +123,6 @@ module Q = struct
|
|||
Caqti_type.(tup2 string string)
|
||||
"INSERT INTO thread_post VALUES (?,?);"
|
||||
|
||||
let upload_image_info =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup3 string string string)
|
||||
"INSERT INTO image_info VALUES (?,?,?);"
|
||||
|
||||
let upload_image_content =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup2 string string)
|
||||
"INSERT INTO image_content VALUES (?,?);"
|
||||
|
||||
let upload_image_thumbnail =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup2 string string)
|
||||
"INSERT INTO image_thumbnail VALUES (?,?);"
|
||||
|
||||
let upload_post_reply =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup2 string string)
|
||||
|
|
@ -189,19 +151,6 @@ module Q = struct
|
|||
Caqti_request.find Caqti_type.string Caqti_type.string
|
||||
"SELECT comment FROM post_comment WHERE post_id=?;"
|
||||
|
||||
let get_post_image_content =
|
||||
Caqti_request.find_opt Caqti_type.string Caqti_type.string
|
||||
"SELECT content FROM image_content WHERE post_id=?;"
|
||||
|
||||
let get_post_image_thumbnail =
|
||||
Caqti_request.find_opt Caqti_type.string Caqti_type.string
|
||||
"SELECT content FROM image_thumbnail WHERE post_id=?;"
|
||||
|
||||
let get_post_image_info =
|
||||
Caqti_request.find_opt Caqti_type.string
|
||||
Caqti_type.(tup2 string string)
|
||||
"SELECT image_name,image_alt FROM image_info WHERE post_id=?;"
|
||||
|
||||
let get_post_tags =
|
||||
Caqti_request.collect Caqti_type.string Caqti_type.string
|
||||
"SELECT tag FROM post_tags WHERE post_id=?;"
|
||||
|
|
@ -261,9 +210,6 @@ let () =
|
|||
; Q.create_post_citations_table
|
||||
; Q.create_post_date_table
|
||||
; Q.create_post_comment_table
|
||||
; Q.create_image_info_table
|
||||
; Q.create_image_content_table
|
||||
; Q.create_image_thumbnail_table
|
||||
; Q.create_post_tags_table
|
||||
; Q.create_report_table
|
||||
|]
|
||||
|
|
@ -273,28 +219,6 @@ let () =
|
|||
(Array.map (fun query -> Db.exec query ()) tables)
|
||||
then Dream.error (fun log -> log "can't create babillard's tables")
|
||||
|
||||
let make_thumbnail content =
|
||||
let open Bos in
|
||||
(* jpp *)
|
||||
let ( let* ) o f =
|
||||
Result.fold ~ok:f ~error:(function `Msg s -> Result.error s) o
|
||||
in
|
||||
|
||||
let* image_file = OS.File.tmp "%s" in
|
||||
let* thumb_file = OS.File.tmp "%s_thumb" in
|
||||
let* () = OS.File.write image_file content in
|
||||
let cmd =
|
||||
Cmd.(
|
||||
v "convert" % "-define" % "jpeg:size=700x700" % p image_file
|
||||
% "-auto-orient" % "-thumbnail" % "300x300>" % "-unsharp" % "0x.5"
|
||||
% "-format" % "jpg" % p thumb_file)
|
||||
in
|
||||
let* () = OS.Cmd.run cmd in
|
||||
let* thumbnail = OS.File.read thumb_file in
|
||||
let* () = OS.File.delete image_file in
|
||||
let* () = OS.File.delete thumb_file in
|
||||
Ok thumbnail
|
||||
|
||||
(*TODO switch to markdown !*)
|
||||
(* insert html into the comment, and keep tracks of citations :
|
||||
-wraps lines starting with ">" with a <span class="quote">
|
||||
|
|
@ -354,24 +278,14 @@ let upload_post ~image post =
|
|||
| Op (thread_data, reply) -> (Some thread_data, reply)
|
||||
| Post reply -> (None, reply)
|
||||
in
|
||||
let { id; parent_id; date; user_id; comment; image_info; tags; citations; _ }
|
||||
=
|
||||
reply
|
||||
in
|
||||
let { id; parent_id; date; user_id; comment; tags; citations; _ } = reply in
|
||||
|
||||
let^ () = Db.exec Q.upload_post_id (id, user_id) in
|
||||
let^ () = Db.exec Q.upload_post_comment (id, comment) in
|
||||
let^ () = Db.exec Q.upload_post_date (id, date) in
|
||||
let^ () = Db.exec Q.upload_thread_post (parent_id, id) in
|
||||
let* () =
|
||||
match image with
|
||||
| None -> Ok ()
|
||||
| Some image ->
|
||||
assert (Option.is_some image_info);
|
||||
let^ () = Db.exec Q.upload_image_info (id, image.name, image.alt) in
|
||||
let^ () = Db.exec Q.upload_image_content (id, image.content) in
|
||||
let^ () = Db.exec Q.upload_image_thumbnail (id, image.thumbnail) in
|
||||
Ok ()
|
||||
match image with None -> Ok () | Some image -> Image.upload image id
|
||||
in
|
||||
let^ _unit_list =
|
||||
unwrap_list (fun tag -> Db.exec Q.upload_post_tag (id, tag)) tags
|
||||
|
|
@ -389,7 +303,7 @@ let upload_post ~image post =
|
|||
|
||||
let build_reply ~comment ~image_info ~tag_list ?parent_id user_id =
|
||||
let comment = Dream.html_escape comment in
|
||||
let id = Uuidm.to_string (Uuidm.v4_gen random_state ()) in
|
||||
let id = Uuidm.to_string (Uuidm.v4_gen App.random_state ()) in
|
||||
(* parent_id is None if this reply is supposed to be a new thread *)
|
||||
let parent_id = Option.value parent_id ~default:id in
|
||||
if Option.is_none (Uuidm.of_string parent_id) then Error "invalid thread id"
|
||||
|
|
@ -443,9 +357,7 @@ let build_op ~comment ~image_info ~tag_list ~categories ~subject ~lat ~lng
|
|||
Ok op
|
||||
|
||||
let build_image image_input =
|
||||
let* name, alt, content = clean_image image_input in
|
||||
let* thumbnail = make_thumbnail content in
|
||||
let image = { name; alt; content; thumbnail } in
|
||||
let* image = Image.make_image image_input in
|
||||
Ok image
|
||||
|
||||
let make_post ~comment ?image_input ~tags ~op_or_reply_data user_id =
|
||||
|
|
@ -473,14 +385,6 @@ let make_post ~comment ?image_input ~tags ~op_or_reply_data user_id =
|
|||
in
|
||||
upload_post ~image post
|
||||
|
||||
let get_post_image_content id =
|
||||
let^? content = Db.find_opt Q.get_post_image_content id in
|
||||
Ok content
|
||||
|
||||
let get_post_image_thumbnail id =
|
||||
let^? content = Db.find_opt Q.get_post_image_thumbnail id in
|
||||
Ok content
|
||||
|
||||
let thread_exist id = Result.is_ok (Db.find Q.get_is_thread id)
|
||||
|
||||
(* true if post is an op too *)
|
||||
|
|
@ -492,7 +396,7 @@ let get_post id =
|
|||
let* nick = User.get_nick user_id in
|
||||
let^ comment = Db.find Q.get_post_comment id in
|
||||
let^ date = Db.find Q.get_post_date id in
|
||||
let^ image_info = Db.find_opt Q.get_post_image_info id in
|
||||
let* image_info = Image.get_info id in
|
||||
|
||||
let^ tags = Db.collect_list Q.get_post_tags id in
|
||||
let^ replies = Db.collect_list Q.get_post_replies id in
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue