separate image_content from image_info
This commit is contained in:
parent
c18825985f
commit
0cbaf29676
3 changed files with 69 additions and 42 deletions
|
|
@ -13,7 +13,7 @@ type reply =
|
|||
; date : int
|
||||
; nick : string
|
||||
; comment : string
|
||||
; image : (string * string * string) option
|
||||
; image_info : (string * string) option
|
||||
; tags : string list
|
||||
; replies : string list
|
||||
; citations : string list
|
||||
|
|
@ -64,11 +64,15 @@ module Q = struct
|
|||
"CREATE TABLE IF NOT EXISTS post_comment (post_id TEXT, comment TEXT, \
|
||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id));"
|
||||
|
||||
let create_post_image_table =
|
||||
let create_image_info_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS post_image (post_id TEXT, image_name TEXT, \
|
||||
image_content TEXT, image_alt TEXT, FOREIGN KEY(post_id) REFERENCES \
|
||||
post_user(post_id));"
|
||||
"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));"
|
||||
|
||||
let create_image_content_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS image_content (post_id TEXT,image_content \
|
||||
TEXT, FOREIGN KEY(post_id) REFERENCES post_user(post_id));"
|
||||
|
||||
let create_post_gps_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
|
|
@ -95,10 +99,15 @@ module Q = struct
|
|||
Caqti_type.(tup3 string float float)
|
||||
"INSERT INTO post_gps VALUES (?,?,?);"
|
||||
|
||||
let upload_post_image =
|
||||
let upload_image_info =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup4 string string string string)
|
||||
"INSERT INTO post_image VALUES (?,?,?,?);"
|
||||
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_post_reply =
|
||||
Caqti_request.exec
|
||||
|
|
@ -145,12 +154,12 @@ module Q = struct
|
|||
|
||||
let get_post_image_content =
|
||||
Caqti_request.find_opt Caqti_type.string Caqti_type.string
|
||||
"SELECT image_content FROM post_image WHERE post_id=?;"
|
||||
"SELECT image_content FROM image_content 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 post_image WHERE post_id=?;"
|
||||
"SELECT image_name,image_alt FROM image_info WHERE post_id=?;"
|
||||
|
||||
let get_post_tags =
|
||||
Caqti_request.collect Caqti_type.string Caqti_type.string
|
||||
|
|
@ -203,7 +212,8 @@ let () =
|
|||
; Q.create_post_citations_table
|
||||
; Q.create_post_date_table
|
||||
; Q.create_post_comment_table
|
||||
; Q.create_post_image_table
|
||||
; Q.create_image_info_table
|
||||
; Q.create_image_content_table
|
||||
; Q.create_post_gps_table
|
||||
; Q.create_post_subject_table
|
||||
; Q.create_post_tags_table
|
||||
|
|
@ -217,7 +227,7 @@ let () =
|
|||
let parse_image image =
|
||||
match image with
|
||||
| None -> Ok None
|
||||
| Some (name, content, alt) ->
|
||||
| Some ((name, alt), content) ->
|
||||
let name =
|
||||
match name with
|
||||
| Some name -> Dream.html_escape name
|
||||
|
|
@ -227,7 +237,7 @@ let parse_image image =
|
|||
in
|
||||
if not (is_valid_image content) then Error "invalid image"
|
||||
else if String.length alt > 1000 then Error "Image description too long"
|
||||
else Ok (Some (name, content, alt))
|
||||
else Ok (Some ((name, alt), content))
|
||||
|
||||
(*TODO switch to markdown !*)
|
||||
(* insert html into the comment, and keep tracks of citations :
|
||||
|
|
@ -302,13 +312,13 @@ let parse_comment comment =
|
|||
let cited_posts = List.sort_uniq String.compare cited_posts in
|
||||
(comment, cited_posts)
|
||||
|
||||
let upload_post post =
|
||||
let upload_post ?image_content post =
|
||||
let thread_data, reply =
|
||||
match post with
|
||||
| Op (thread_data, reply) -> (Some thread_data, reply)
|
||||
| Reply reply -> (None, reply)
|
||||
in
|
||||
let { id; parent_id; date; nick; comment; image; tags; citations; _ } =
|
||||
let { id; parent_id; date; nick; comment; image_info; tags; citations; _ } =
|
||||
reply
|
||||
in
|
||||
|
||||
|
|
@ -316,11 +326,15 @@ let upload_post post =
|
|||
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_to_thread (parent_id, id) in
|
||||
let^ () =
|
||||
match image with
|
||||
| None -> Ok ()
|
||||
| Some (image_name, image_content, alt) ->
|
||||
Db.exec Q.upload_post_image (id, image_name, image_content, alt)
|
||||
let _res_image_info, _res_image_content =
|
||||
match image_info with
|
||||
| None -> (Ok (), Ok ())
|
||||
| Some (name, alt) -> (
|
||||
match image_content with
|
||||
| None -> failwith "No image_content for a post with image"
|
||||
| Some content ->
|
||||
( Db.exec Q.upload_image_info (id, name, alt)
|
||||
, Db.exec Q.upload_image_content (id, content) ) )
|
||||
in
|
||||
(* what is parent and why do i need it again? TODO TODO *)
|
||||
let^ () = Db.exec Q.upload_post_parent (id, parent_id) in
|
||||
|
|
@ -365,7 +379,11 @@ let build_reply ~comment ?image ~tags ?parent_id nick =
|
|||
| Ok image ->
|
||||
if String.length tags > 1000 then Error "invalid tags"
|
||||
else
|
||||
(* TODO latlng validation? *)
|
||||
let image_info =
|
||||
match image with
|
||||
| None -> None
|
||||
| Some (image_info, _image_content) -> Some image_info
|
||||
in
|
||||
let tag_list = Str.split (Str.regexp " +") tags in
|
||||
let date = int_of_float (Unix.time ()) in
|
||||
let comment, citations = parse_comment comment in
|
||||
|
|
@ -375,7 +393,7 @@ let build_reply ~comment ?image ~tags ?parent_id nick =
|
|||
; date
|
||||
; nick
|
||||
; comment
|
||||
; image
|
||||
; image_info
|
||||
; tags = tag_list
|
||||
; replies = []
|
||||
; citations
|
||||
|
|
@ -402,11 +420,15 @@ let build_op ~comment ?image ~tags ~subject ~lat ~lng nick =
|
|||
let make_reply ~comment ?image ~tags ~parent_id nick =
|
||||
let* reply = build_reply ~comment ?image ~tags ~parent_id nick in
|
||||
let post = Reply reply in
|
||||
upload_post post
|
||||
match image with
|
||||
| None -> upload_post post
|
||||
| Some (_image_info, image_content) -> upload_post ~image_content post
|
||||
|
||||
let make_op ~comment ?image ~tags ~subject ~lat ~lng nick =
|
||||
let* op = build_op ~comment ?image ~tags ~subject ~lat ~lng nick in
|
||||
upload_post op
|
||||
match image with
|
||||
| None -> upload_post op
|
||||
| Some (_image_info, image_content) -> upload_post ~image_content op
|
||||
|
||||
let get_post_image_content post_id =
|
||||
let^? content = Db.find_opt Q.get_post_image_content post_id in
|
||||
|
|
|
|||
|
|
@ -152,7 +152,7 @@ let newthread_post request =
|
|||
| [] -> Babillard.make_op ~comment ~lat ~lng ~subject ~tags nick
|
||||
| _ :: _ :: _ -> Error "More than one image"
|
||||
| [ (image_name, image_content) ] ->
|
||||
let image = (image_name, image_content, alt) in
|
||||
let image = ((image_name, alt), image_content) in
|
||||
Babillard.make_op ~comment ~image ~lat ~lng ~subject ~tags nick
|
||||
in
|
||||
match res with
|
||||
|
|
@ -200,7 +200,7 @@ let reply_post request =
|
|||
match file with
|
||||
| [] -> Babillard.make_reply ~comment ~tags ~parent_id nick
|
||||
| [ (image_name, image_content) ] ->
|
||||
let image = (image_name, image_content, alt) in
|
||||
let image = ((image_name, alt), image_content) in
|
||||
Babillard.make_reply ~comment ~image ~tags ~parent_id nick
|
||||
| _ :: _ :: _ -> Error "More than one image"
|
||||
in
|
||||
|
|
@ -247,6 +247,6 @@ let () =
|
|||
; Dream.post "/new_thread" newthread_post
|
||||
; Dream.get "/:thread_id" thread_get
|
||||
; Dream.post "/:thread_id" reply_post
|
||||
; Dream.get "/post_pic/:post_id" post_image
|
||||
; Dream.get "/img/:post_id" post_image
|
||||
]
|
||||
@@ Dream.not_found
|
||||
|
|
|
|||
|
|
@ -2,14 +2,19 @@ include Bindings
|
|||
include Babillard
|
||||
open Db
|
||||
|
||||
let view_post ?is_thread_preview post_id =
|
||||
let^ nick = Db.find Q.get_post_nick post_id in
|
||||
let^ comment = Db.find Q.get_post_comment post_id in
|
||||
let^ date = Db.find Q.get_post_date post_id in
|
||||
let^ image_info = Db.find_opt Q.get_post_image_info post_id in
|
||||
|
||||
let^ tags = Db.collect_list Q.get_post_tags post_id in
|
||||
let^ replies = Db.collect_list Q.get_post_replies post_id in
|
||||
let view_post ?is_thread_preview id =
|
||||
let* { id
|
||||
; parent_id = _parent_id
|
||||
; date
|
||||
; nick
|
||||
; comment
|
||||
; image_info
|
||||
; tags
|
||||
; replies
|
||||
; citations = _citations
|
||||
} =
|
||||
get_post id
|
||||
in
|
||||
|
||||
let image_view fmt () =
|
||||
match image_info with
|
||||
|
|
@ -19,12 +24,12 @@ let view_post ?is_thread_preview post_id =
|
|||
Format.fprintf fmt
|
||||
{|
|
||||
<div class="postImageContainer">
|
||||
<a href="/post_pic/%s">
|
||||
<img class="postImage" src="/post_pic/%s" alt="%s" title="%s" loading="lazy">
|
||||
<a href="/img/%s">
|
||||
<img class="postImage" src="/img/%s" alt="%s" title="%s" loading="lazy">
|
||||
</a>
|
||||
</div>
|
||||
|}
|
||||
post_id post_id image_alt image_alt
|
||||
id id image_alt image_alt
|
||||
| None -> Format.fprintf fmt ""
|
||||
in
|
||||
|
||||
|
|
@ -42,7 +47,7 @@ let view_post ?is_thread_preview post_id =
|
|||
match is_thread_preview with
|
||||
| None -> pp_print_replies fmt replies
|
||||
| Some () -> (
|
||||
let res_nb = Db.find Q.count_thread_posts post_id in
|
||||
let res_nb = Db.find Q.count_thread_posts id in
|
||||
match res_nb with
|
||||
| Error _ -> Format.fprintf fmt ""
|
||||
| Ok ((1 | 2) as nb) ->
|
||||
|
|
@ -62,7 +67,7 @@ let view_post ?is_thread_preview post_id =
|
|||
</span>
|
||||
%a
|
||||
|}
|
||||
post_id post_id post_id replies_view ()
|
||||
id id id replies_view ()
|
||||
| Some () -> Format.fprintf fmt {|
|
||||
%a
|
||||
|} replies_view ()
|
||||
|
|
@ -102,7 +107,7 @@ let view_post ?is_thread_preview post_id =
|
|||
</div>
|
||||
</div>
|
||||
|}
|
||||
post_id post_info_view () image_view () comment tags_view ()
|
||||
id post_info_view () image_view () comment tags_view ()
|
||||
in
|
||||
Ok post_view
|
||||
|
||||
|
|
@ -124,7 +129,7 @@ let preview_thread thread_id =
|
|||
Ok thread_preview
|
||||
|
||||
let view_thread thread_id =
|
||||
let^ _is_thread = Db.find Q.get_thread thread_id in
|
||||
let^ _is_thread = Db.find Q.get_is_thread thread_id in
|
||||
let^? subject = Db.find_opt Q.get_post_subject thread_id in
|
||||
let^ thread_posts = Db.collect_list Q.get_thread_posts thread_id in
|
||||
(*order by date *)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue