From 3ffe5023d3a0e7eaca7d8e4580891c30e979186b Mon Sep 17 00:00:00 2001 From: Swrup Date: Mon, 21 Feb 2022 01:59:36 +0100 Subject: [PATCH] preview_thread -> pp_thread_preview; changed post's type --- src/babillard.ml | 30 +++++++++++++++++++++--------- src/pp_babillard.ml | 36 ++++++++++++++++++++++++------------ 2 files changed, 45 insertions(+), 21 deletions(-) diff --git a/src/babillard.ml b/src/babillard.ml index 3d5fcd0..3c74ced 100644 --- a/src/babillard.ml +++ b/src/babillard.ml @@ -7,7 +7,7 @@ type thread_data = ; lat : float } -type reply = +type post = { id : string ; parent_id : string ; date : int @@ -19,9 +19,9 @@ type reply = ; citations : string list } -type post = - | Op of thread_data * reply - | Reply of reply +type t = + | Op of thread_data * post + | Post of post module Q = struct let create_post_user_table = @@ -299,7 +299,7 @@ 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) + | Post reply -> (None, reply) in let { id; parent_id; date; nick; comment; image_info; tags; citations; _ } = reply @@ -399,7 +399,7 @@ 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 + let post = Post reply in match image with | None -> upload_post post | Some (_image_info, image_content) -> upload_post ~image_content post @@ -414,6 +414,11 @@ let get_post_image_content id = let^? content = Db.find_opt Q.get_post_image_content id in Ok content +let thread_exists id = Result.is_ok (Db.find Q.get_is_thread id) + +(* true if post is an op too *) +let post_exists id = Result.is_ok (Db.find Q.get_is_post id) + let get_post id = let^ parent_id = Db.find Q.get_post_thread id in let^ nick = Db.find Q.get_post_nick id in @@ -429,7 +434,14 @@ let get_post id = in Ok reply -let thread_exists id = Result.is_ok (Db.find Q.get_is_thread id) +let get_thread_data id = + if thread_exists id then + let^? subject, lat, lng = Db.find_opt Q.get_thread_info id in + let thread_data = { subject; lat; lng } in + Ok thread_data + else Error "not an op" -(* true if post is an op too *) -let post_exists id = Result.is_ok (Db.find Q.get_is_post id) +let get_op id = + let* thread_data = get_thread_data id in + let* reply = get_post id in + Ok (thread_data, reply) diff --git a/src/pp_babillard.ml b/src/pp_babillard.ml index 2639542..0f9f3e1 100644 --- a/src/pp_babillard.ml +++ b/src/pp_babillard.ml @@ -109,12 +109,11 @@ let pp_post fmt ~hide_replies post = in pp -let preview_thread thread_id = - let* post_data = get_post thread_id in - let^? subject, _lat, _lng = Db.find_opt Q.get_thread_info thread_id in - let post = +let pp_thread_preview op = + let thread_data, post = op in + let post_view = (Format.asprintf "%a" (fun fmt data -> pp_post fmt ~hide_replies:true data)) - post_data + post in let thread_preview = Format.sprintf @@ -126,14 +125,21 @@ let preview_thread thread_id = %s |} - subject post + thread_data.subject post_view in - Ok thread_preview + thread_preview let catalog_content () = Format.printf "catalog_content@."; let^ threads = Db.collect_list Q.get_threads () in - let res_previews = List.map preview_thread threads in + let res_previews = + List.map + (fun id -> + let* op = get_op id in + Ok (pp_thread_preview op) ) + threads + in + let res_opt = List.find_opt Result.is_error res_previews in if Option.is_some res_opt then Option.get res_opt else @@ -192,9 +198,15 @@ let view_thread thread_id = Ok thread_view let get_markers () = - let^ threads = Db.collect_list Q.get_threads () in - let res_previews = List.map preview_thread threads in - let res_infos = List.map (Db.find Q.get_thread_info) threads in + let^ ids = Db.collect_list Q.get_threads () in + let res_previews = + List.map + (fun id -> + let* op = get_op id in + Ok (pp_thread_preview op) ) + ids + in + let res_infos = List.map (Db.find Q.get_thread_info) ids in let res_previews_opt = List.find_opt Result.is_error res_previews in let res_info_opt = List.find_opt Result.is_error res_infos in @@ -208,7 +220,7 @@ let get_markers () = let previews = List.map Result.get_ok res_previews in let infos = List.map Result.get_ok res_infos in let previews_infos = List.combine previews infos in - let previews_infos_ids = List.combine previews_infos threads in + let previews_infos_ids = List.combine previews_infos ids in let pp_marker fmt lat lng content thread_id = (* geojson use lng lat, and not lat lng*)