big fix
This commit is contained in:
parent
be599322da
commit
a3150b9750
8 changed files with 132 additions and 143 deletions
|
|
@ -8,103 +8,101 @@ let view_post ?is_thread_preview post_id =
|
|||
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.fold Q.get_post_tags (fun tag acc -> tag :: acc) post_id [] in
|
||||
let^ replies =
|
||||
Db.fold Q.get_post_replies (fun reply_id acc -> reply_id :: acc) 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 image_view =
|
||||
let image_view fmt () =
|
||||
match image_info with
|
||||
| Some (_image_name, image_alt) ->
|
||||
(*TODO thumbnails *)
|
||||
(*TODO image info like file name and size on top of image*)
|
||||
Format.sprintf
|
||||
Format.fprintf fmt
|
||||
{|
|
||||
<div class="postImageContainer">
|
||||
<a href="/post_pic/%s" target="_blank">
|
||||
<a href="/post_pic/%s">
|
||||
<img class="postImage" src="/post_pic/%s" alt="%s" title="%s" loading="lazy">
|
||||
</a>
|
||||
</div>
|
||||
|}
|
||||
post_id post_id image_alt image_alt
|
||||
| None -> ""
|
||||
| None -> Format.fprintf fmt ""
|
||||
in
|
||||
|
||||
let pp_print_reply fmt reply =
|
||||
Format.fprintf fmt {|<a class="replyLink" href="#%s">>>%s</a>|} reply
|
||||
reply
|
||||
in
|
||||
let pp_print_replies replies =
|
||||
Format.asprintf {|<div class="replies">%a</div>|}
|
||||
let pp_print_replies fmt replies =
|
||||
Format.fprintf fmt {|<div class="replies">%a</div>|}
|
||||
(Format.pp_print_list ~pp_sep:Format.pp_print_space pp_print_reply)
|
||||
replies
|
||||
in
|
||||
|
||||
let replies_view =
|
||||
let replies_view fmt () =
|
||||
match is_thread_preview with
|
||||
| None -> pp_print_replies replies
|
||||
| None -> pp_print_replies fmt replies
|
||||
| Some () -> (
|
||||
let res_nb = Db.find Q.count_thread_posts post_id in
|
||||
match res_nb with
|
||||
| Error _ -> ""
|
||||
| Error _ -> Format.fprintf fmt ""
|
||||
| Ok ((1 | 2) as nb) ->
|
||||
Format.sprintf {|<div class="replies">%d reply</div>|} (nb - 1)
|
||||
Format.fprintf fmt {|<div class="replies">%d reply</div>|} (nb - 1)
|
||||
| Ok nb ->
|
||||
Format.sprintf {|<div class="replies">%d replies</div>|} (nb - 1) )
|
||||
Format.fprintf fmt {|<div class="replies">%d replies</div>|} (nb - 1) )
|
||||
in
|
||||
|
||||
let post_links_view =
|
||||
let post_links_view fmt () =
|
||||
match is_thread_preview with
|
||||
| None ->
|
||||
Format.sprintf
|
||||
Format.fprintf fmt
|
||||
{|
|
||||
<span class=postNo>
|
||||
<a href="#%s" title="Link to this post">#</a>
|
||||
<a href="javascript:insert_quote('%s')" "class=quoteLink title="Reply to this post">%s</a>
|
||||
<a href="javascript:insert_quote('%s')" class="quoteLink" title="Reply to this post">%s</a>
|
||||
</span>
|
||||
%s
|
||||
%a
|
||||
|}
|
||||
post_id post_id post_id replies_view
|
||||
| Some () -> Format.sprintf {|
|
||||
%s
|
||||
|} replies_view
|
||||
post_id post_id post_id replies_view ()
|
||||
| Some () -> Format.fprintf fmt {|
|
||||
%a
|
||||
|} replies_view ()
|
||||
in
|
||||
|
||||
let post_info_view =
|
||||
Format.sprintf
|
||||
let post_info_view fmt () =
|
||||
Format.fprintf fmt
|
||||
{|
|
||||
<div class="postInfo">
|
||||
<span class="nick">%s</span>
|
||||
<span class="date" data-time="%d"></span>
|
||||
%s
|
||||
%a
|
||||
</div>|}
|
||||
nick date post_links_view
|
||||
nick date post_links_view ()
|
||||
in
|
||||
|
||||
let pp_print_tag fmt tag =
|
||||
Format.fprintf fmt {|<span class="tag">%s</span>|} tag
|
||||
in
|
||||
let pp_print_tags tags =
|
||||
Format.asprintf {|<div class="tags">%a</div>|}
|
||||
let pp_print_tags fmt tags =
|
||||
Format.fprintf fmt {|<div class="tags">%a</div>|}
|
||||
(Format.pp_print_list ~pp_sep:Format.pp_print_space pp_print_tag)
|
||||
tags
|
||||
in
|
||||
let tags = List.sort String.compare tags in
|
||||
let tags_view = pp_print_tags tags in
|
||||
let tags_view fmt () = pp_print_tags fmt tags in
|
||||
|
||||
let post_view =
|
||||
Format.sprintf
|
||||
Format.asprintf
|
||||
{|
|
||||
<div class="container">
|
||||
<div class="post" id="%s">
|
||||
%s
|
||||
%s
|
||||
%a
|
||||
%a
|
||||
<blockquote class="postComment">%s</blockquote>
|
||||
%s
|
||||
%a
|
||||
</div>
|
||||
</div>
|
||||
|}
|
||||
post_id post_info_view image_view comment tags_view
|
||||
post_id post_info_view () image_view () comment tags_view ()
|
||||
in
|
||||
Ok post_view
|
||||
|
||||
|
|
@ -126,46 +124,40 @@ let preview_thread thread_id =
|
|||
Ok thread_preview
|
||||
|
||||
let view_thread thread_id =
|
||||
let^ is_thread = Db.find Q.is_thread thread_id in
|
||||
if not is_thread then
|
||||
Error "This thread doesn't exists"
|
||||
else
|
||||
let^? subject = Db.find_opt Q.get_post_subject thread_id in
|
||||
let^ thread_posts = Db.fold Q.get_thread_posts List.cons thread_id [] in
|
||||
(*order by date *)
|
||||
let dates =
|
||||
List.map (fun post_id -> Db.find Q.get_post_date post_id) thread_posts
|
||||
let^ _is_thread = Db.find Q.get_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 *)
|
||||
let dates = List.map (Db.find Q.get_post_date) thread_posts in
|
||||
match List.find_opt Result.is_error dates with
|
||||
| Some (Error e) -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
|
||||
| Some (Ok _) -> assert false
|
||||
| None -> (
|
||||
let dates = List.map Result.get_ok dates in
|
||||
let posts_dates = List.combine thread_posts dates in
|
||||
let sorted_posts_dates =
|
||||
List.sort (fun (_, a) (_, b) -> compare a b) posts_dates
|
||||
in
|
||||
match List.find_opt Result.is_error dates with
|
||||
| Some (Error e) ->
|
||||
Error (Format.sprintf "db error: %s" (Caqti_error.show e))
|
||||
| Some (Ok _) -> assert false
|
||||
| None -> (
|
||||
let dates = List.map Result.get_ok dates in
|
||||
let posts_dates = List.combine thread_posts dates in
|
||||
let sorted_posts_dates =
|
||||
List.sort (fun (_, a) (_, b) -> compare a b) posts_dates
|
||||
in
|
||||
|
||||
let posts, _ = List.split sorted_posts_dates in
|
||||
let view_posts = List.map view_post posts in
|
||||
match List.find_opt Result.is_error view_posts with
|
||||
| Some (Error e) -> Error e
|
||||
| Some (Ok _) -> assert false
|
||||
| None ->
|
||||
let posts =
|
||||
List.map Result.get_ok (List.filter Result.is_ok view_posts)
|
||||
in
|
||||
let posts =
|
||||
Format.asprintf "%a"
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt "\r\n")
|
||||
Format.pp_print_string )
|
||||
posts
|
||||
in
|
||||
let thread_view =
|
||||
Format.sprintf
|
||||
{|
|
||||
let posts, _ = List.split sorted_posts_dates in
|
||||
let view_posts = List.map view_post posts in
|
||||
match List.find_opt Result.is_error view_posts with
|
||||
| Some (Error e) -> Error e
|
||||
| Some (Ok _) -> assert false
|
||||
| None ->
|
||||
let posts =
|
||||
List.map Result.get_ok (List.filter Result.is_ok view_posts)
|
||||
in
|
||||
let posts =
|
||||
Format.asprintf "%a"
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt "\r\n")
|
||||
Format.pp_print_string )
|
||||
posts
|
||||
in
|
||||
let thread_view =
|
||||
Format.sprintf
|
||||
{|
|
||||
<div class="thread">
|
||||
<div class="threadSubject">
|
||||
%s
|
||||
|
|
@ -175,12 +167,12 @@ let view_thread thread_id =
|
|||
</div>
|
||||
</div>
|
||||
|}
|
||||
subject posts
|
||||
in
|
||||
Ok thread_view )
|
||||
subject posts
|
||||
in
|
||||
Ok thread_view )
|
||||
|
||||
let get_markers () =
|
||||
let^ thread_id_list = Db.fold Q.get_threads List.cons () [] in
|
||||
let^ thread_id_list = Db.collect_list Q.get_threads () in
|
||||
let markers_res =
|
||||
List.map
|
||||
(fun thread_id ->
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue