split printing functions

src/babillard.ml

@@ -353,139 +353,6 @@ let parse_comment comment =
   let cited_posts = List.sort_uniq String.compare cited_posts in
   (comment, cited_posts)
 
-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.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
-
-  (* TODO special stuff for OP
-     let* _subject = Db.find_opt Q.get_post_subject post_id in
-     let* _latlng = Db.find_opt Q.get_post_gps post_id in
-  *)
-  let image_view =
-    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
-        {|
-    <div class="postImageContainer">
-        <a href="/post_pic/%s" target="_blank">
-        <img class="postImage" src="/post_pic/%s" alt="%s" title="%s" loading="lazy">
-        </a>
-    </div> 
-|}
-        post_id post_id image_alt image_alt
-    | None -> ""
-  in
-
-  let pp_print_reply fmt reply =
-    Format.fprintf fmt {|<a class="replyLink" href="#%s">&gt;&gt;%s</a>|} reply
-      reply
-  in
-  let pp_print_replies =
-    Format.asprintf {|<div class="replies">%a</div>|}
-      (Format.pp_print_list ~pp_sep:Format.pp_print_space pp_print_reply)
-  in
-
-  let replies_view =
-    match is_thread_preview with
-    | None -> pp_print_replies replies
-    | Some () -> (
-      let res_nb = Db.find Q.count_thread_posts post_id in
-      match res_nb with
-      | Error _ -> ""
-      | Ok ((1 | 2) as nb) ->
-        Format.sprintf {|<div class="replies">%d reply</div>|} (nb - 1)
-      | Ok nb ->
-        Format.sprintf {|<div class="replies">%d replies</div>|} (nb - 1) )
-  in
-
-  let post_links_view =
-    match is_thread_preview with
-    | None ->
-      Format.sprintf
-        {|
-        <span class=postNo>
-            <a href="#%s" title="Link to this post">No.</a>
-            <a href="javascript:insert_quote('%s')" "class=quoteLink title="Reply to this post">%s</a>
-        </span>
-        %s
-        |}
-        post_id post_id post_id replies_view
-    | Some () -> Format.sprintf {|
-        %s
-        |} replies_view
-  in
-
-  let post_info_view =
-    Format.sprintf
-      {|
-    <div class="postInfo">
-        <span class="nick">%s</span>
-        <span class="date" data-time="%d"></span>
-        %s
-    </div>|}
-      nick date post_links_view
-  in
-  let post_view =
-    Format.sprintf
-      {|
-<div class="container">
-        <div class="post" id="%s">
-            %s
-            %s
-            <blockquote class="postComment">%s</blockquote> 
-        </div> 
-</div> 
-|}
-      post_id post_info_view image_view comment
-  in
-  Ok post_view
-
-let preview_thread thread_id = view_post ~is_thread_preview:() thread_id
-
-let view_thread thread_id =
-  let** _ = Db.find_opt Q.is_thread 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
-  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 view_posts =
-        List.map Result.get_ok (List.filter Result.is_ok view_posts)
-      in
-      let view_posts =
-        Format.asprintf "%a"
-          (Format.pp_print_list
-             ~pp_sep:(fun fmt () -> Format.fprintf fmt "\r\n")
-             Format.pp_print_string )
-          view_posts
-      in
-      Ok view_posts )
-
 let upload_post post =
   let thread_data, reply =
     match post with
@@ -616,46 +483,6 @@ let make_op ~comment ?image ~tags ~subject ~lat ~lng ~board nick =
   let+ op = build_op ~comment ?image ~tags ~subject ~lat ~lng ~board nick in
   upload_post op
 
-let get_markers board =
-  let* thread_id_list =
-    Db.fold Q.list_threads List.cons (int_of_board board) []
-  in
-  let markers_res =
-    List.map
-      (fun thread_id ->
-        let** lat, lng = Db.find_opt Q.get_post_gps thread_id in
-        match preview_thread thread_id with
-        | Ok content -> Ok (lat, lng, content, thread_id)
-        | Error e -> Error e )
-      thread_id_list
-  in
-  let markers = List.map Result.get_ok (List.filter Result.is_ok markers_res) in
-
-  let pp_marker fmt (lat, lng, content, thread_id) =
-    Format.fprintf fmt
-      {|{
-  "type": "Feature",
-  "geometry": {
-    "type": "Point",
-    "coordinates": [%s,%s]
-  },
-  "properties": {
-    "content": "%s",
-    "thread_id": "%s"
-  }}|}
-      (* geojson use lng lat, and not lat lng*)
-      (Float.to_string lng)
-      (Float.to_string lat) (String.escaped content) thread_id
-  in
-  let markers =
-    Format.asprintf "[%a]"
-      (Format.pp_print_list
-         ~pp_sep:(fun fmt () -> Format.fprintf fmt ",")
-         pp_marker )
-      markers
-  in
-  Ok markers
-
 let get_post_image_content post_id =
   let** content = Db.find_opt Q.get_post_image_content post_id in
   Ok content

src/dune

@@ -4,6 +4,7 @@
   newthread_page
   thread_page
   babillard
+  pp_babillard
   babillard_page
   db
   app

src/permap.ml

@@ -149,7 +149,7 @@ let post_image request =
   | Error _ -> Dream.empty `Not_Found
 
 let markers ~board request =
-  let markers = Babillard.get_markers board in
+  let markers = Pp_babillard.get_markers board in
   match markers with
   | Ok markers ->
     Dream.respond ~headers:[ ("Content-Type", "application/json") ] markers
@@ -216,7 +216,7 @@ let newthread_post ~board request =
 
 let thread_get request =
   let thread_id = Dream.param "thread_id" request in
-  let thread_view = Babillard.view_thread thread_id in
+  let thread_view = Pp_babillard.view_thread thread_id in
   match thread_view with
   | Error e -> render_unsafe e request
   | Ok thread_view ->
@@ -225,7 +225,7 @@ let thread_get request =
 (* get thread view but not wrapped in template, so we can display it on /babillard*)
 let thread_view request =
   let thread_id = Dream.param "thread_id" request in
-  let thread_view = Babillard.view_thread thread_id in
+  let thread_view = Pp_babillard.view_thread thread_id in
   match thread_view with
   | Error e -> render_unsafe e request
   | Ok thread_view -> Dream.html (Thread_page.f thread_view thread_id request)

src/pp_babillard.ml

@@ -0,0 +1,175 @@
+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.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
+
+  (* TODO special stuff for OP
+     let* _subject = Db.find_opt Q.get_post_subject post_id in
+     let* _latlng = Db.find_opt Q.get_post_gps post_id in
+  *)
+  let image_view =
+    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
+        {|
+    <div class="postImageContainer">
+        <a href="/post_pic/%s" target="_blank">
+        <img class="postImage" src="/post_pic/%s" alt="%s" title="%s" loading="lazy">
+        </a>
+    </div> 
+|}
+        post_id post_id image_alt image_alt
+    | None -> ""
+  in
+
+  let pp_print_reply fmt reply =
+    Format.fprintf fmt {|<a class="replyLink" href="#%s">&gt;&gt;%s</a>|} reply
+      reply
+  in
+  let pp_print_replies =
+    Format.asprintf {|<div class="replies">%a</div>|}
+      (Format.pp_print_list ~pp_sep:Format.pp_print_space pp_print_reply)
+  in
+
+  let replies_view =
+    match is_thread_preview with
+    | None -> pp_print_replies replies
+    | Some () -> (
+      let res_nb = Db.find Q.count_thread_posts post_id in
+      match res_nb with
+      | Error _ -> ""
+      | Ok ((1 | 2) as nb) ->
+        Format.sprintf {|<div class="replies">%d reply</div>|} (nb - 1)
+      | Ok nb ->
+        Format.sprintf {|<div class="replies">%d replies</div>|} (nb - 1) )
+  in
+
+  let post_links_view =
+    match is_thread_preview with
+    | None ->
+      Format.sprintf
+        {|
+        <span class=postNo>
+            <a href="#%s" title="Link to this post">No.</a>
+            <a href="javascript:insert_quote('%s')" "class=quoteLink title="Reply to this post">%s</a>
+        </span>
+        %s
+        |}
+        post_id post_id post_id replies_view
+    | Some () -> Format.sprintf {|
+        %s
+        |} replies_view
+  in
+
+  let post_info_view =
+    Format.sprintf
+      {|
+    <div class="postInfo">
+        <span class="nick">%s</span>
+        <span class="date" data-time="%d"></span>
+        %s
+    </div>|}
+      nick date post_links_view
+  in
+  let post_view =
+    Format.sprintf
+      {|
+<div class="container">
+        <div class="post" id="%s">
+            %s
+            %s
+            <blockquote class="postComment">%s</blockquote> 
+        </div> 
+</div> 
+|}
+      post_id post_info_view image_view comment
+  in
+  Ok post_view
+
+let preview_thread thread_id = view_post ~is_thread_preview:() thread_id
+
+let view_thread thread_id =
+  let** _ = Db.find_opt Q.is_thread 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
+  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 view_posts =
+        List.map Result.get_ok (List.filter Result.is_ok view_posts)
+      in
+      let view_posts =
+        Format.asprintf "%a"
+          (Format.pp_print_list
+             ~pp_sep:(fun fmt () -> Format.fprintf fmt "\r\n")
+             Format.pp_print_string )
+          view_posts
+      in
+      Ok view_posts )
+
+let get_markers board =
+  let* thread_id_list =
+    Db.fold Q.list_threads List.cons (int_of_board board) []
+  in
+  let markers_res =
+    List.map
+      (fun thread_id ->
+        let** lat, lng = Db.find_opt Q.get_post_gps thread_id in
+        match preview_thread thread_id with
+        | Ok content -> Ok (lat, lng, content, thread_id)
+        | Error e -> Error e )
+      thread_id_list
+  in
+  let markers = List.map Result.get_ok (List.filter Result.is_ok markers_res) in
+
+  let pp_marker fmt (lat, lng, content, thread_id) =
+    Format.fprintf fmt
+      {|{
+  "type": "Feature",
+  "geometry": {
+    "type": "Point",
+    "coordinates": [%s,%s]
+  },
+  "properties": {
+    "content": "%s",
+    "thread_id": "%s"
+  }}|}
+      (* geojson use lng lat, and not lat lng*)
+      (Float.to_string lng)
+      (Float.to_string lat) (String.escaped content) thread_id
+  in
+  let markers =
+    Format.asprintf "[%a]"
+      (Format.pp_print_list
+         ~pp_sep:(fun fmt () -> Format.fprintf fmt ",")
+         pp_marker )
+      markers
+  in
+  Ok markers