preview_thread -> pp_thread_preview; changed post's type

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)

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
 </div>
 |}
-      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*)