diff --git a/src/babillard.ml b/src/babillard.ml
index bf12343..2da4019 100644
--- a/src/babillard.ml
+++ b/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
- {|
-
-
- 
-
-
%a
|}
- (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 {|%d reply
|} (nb - 1)
- | Ok nb ->
- Format.sprintf {|%d replies
|} (nb - 1) )
- in
-
- let post_links_view =
- match is_thread_preview with
- | None ->
- Format.sprintf
- {|
-
- No.
- %s
-
- %s
- |}
- post_id post_id post_id replies_view
- | Some () -> Format.sprintf {|
- %s
- |} replies_view
- in
-
- let post_info_view =
- Format.sprintf
- {|
-
- %s
-
- %s
-
|}
- nick date post_links_view
- in
- let post_view =
- Format.sprintf
- {|
-
-|}
- 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
diff --git a/src/dune b/src/dune
index 4e3f6da..1b2fd2a 100644
--- a/src/dune
+++ b/src/dune
@@ -4,6 +4,7 @@
newthread_page
thread_page
babillard
+ pp_babillard
babillard_page
db
app
diff --git a/src/permap.ml b/src/permap.ml
index 88c02d7..e4cbd81 100644
--- a/src/permap.ml
+++ b/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)
diff --git a/src/pp_babillard.ml b/src/pp_babillard.ml
new file mode 100644
index 0000000..5e94294
--- /dev/null
+++ b/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
+ {|
+
+
+
+
+
%a
|}
+ (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 {|%d reply
|} (nb - 1)
+ | Ok nb ->
+ Format.sprintf {|%d replies
|} (nb - 1) )
+ in
+
+ let post_links_view =
+ match is_thread_preview with
+ | None ->
+ Format.sprintf
+ {|
+
+ No.
+ %s
+
+ %s
+ |}
+ post_id post_id post_id replies_view
+ | Some () -> Format.sprintf {|
+ %s
+ |} replies_view
+ in
+
+ let post_info_view =
+ Format.sprintf
+ {|
+
+ %s
+
+ %s
+
|}
+ nick date post_links_view
+ in
+ let post_view =
+ Format.sprintf
+ {|
+
+|}
+ 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