From be599322da5fff9f366fc80483398390ee4d79e2 Mon Sep 17 00:00:00 2001 From: Swrup Date: Thu, 17 Feb 2022 03:59:23 +0100 Subject: [PATCH] clean babillard, remove option for multiple boards --- src/babillard.ml | 128 ++++++++++--------------------- src/babillard_page.eml.html | 8 +- src/bindings.ml | 2 +- src/content/assets/css/style.css | 4 +- src/js/js_map.ml | 9 +-- src/newthread_page.eml.html | 7 +- src/permap.ml | 30 +++----- src/pp_babillard.ml | 82 ++++++++++---------- 8 files changed, 104 insertions(+), 166 deletions(-) diff --git a/src/babillard.ml b/src/babillard.ml index 32efce5..e489e19 100644 --- a/src/babillard.ml +++ b/src/babillard.ml @@ -1,23 +1,8 @@ open Db include Bindings -exception Invalid_post of string - -type board = Babillard - -let int_of_board = function - | Babillard -> 1 - -let pp_board fmt = function - | Babillard -> Format.fprintf fmt "babillard" - -let board_of_int = function - | 1 -> Babillard - | _ -> raise (Invalid_argument "board_of_int") - type thread_data = - { board : board - ; subject : string + { subject : string ; lng : float ; lat : float } @@ -51,12 +36,6 @@ module Q = struct FOREIGN KEY(post_id) REFERENCES post_user(post_id),\n\ \ FOREIGN KEY(parent_id) REFERENCES post_user(post_id));" - let create_thread_board_table = - Caqti_request.exec Caqti_type.unit - "CREATE TABLE IF NOT EXISTS thread_board (thread_id TEXT, board INT, \ - FOREIGN KEY(thread_id) REFERENCES post_user(post_id));" - - (* TODO useless? *) let create_thread_table = Caqti_request.exec Caqti_type.unit "CREATE TABLE IF NOT EXISTS threads (thread_id TEXT, post_id TEXT,\n\ @@ -151,11 +130,6 @@ module Q = struct Caqti_type.(tup2 string string) "INSERT INTO threads VALUES (?,?);" - let upload_thread_board = - Caqti_request.exec - Caqti_type.(tup2 string int) - "INSERT INTO thread_board VALUES (?,?);" - let upload_post_parent = Caqti_request.exec Caqti_type.(tup2 string string) @@ -202,14 +176,9 @@ module Q = struct Caqti_request.find Caqti_type.string Caqti_type.int "SELECT COUNT(post_id) FROM threads WHERE thread_id=?;" - (* TODO return bool *) let is_thread = - Caqti_request.find_opt Caqti_type.string Caqti_type.string - "SELECT thread_id FROM threads WHERE thread_id=? LIMIT 1;" - - let get_thread_board = - Caqti_request.find Caqti_type.string Caqti_type.int - "SELECT board FROM thread_board WHERE thread_id=? LIMIT 1;" + Caqti_request.find Caqti_type.string Caqti_type.bool + "IF EXISTS (SELECT thread_id FROM threads WHERE thread_id=? LIMIT 1);" let get_post_subject = Caqti_request.find_opt Caqti_type.string Caqti_type.string @@ -220,9 +189,9 @@ module Q = struct Caqti_type.(tup2 float float) "SELECT lat, lng FROM post_gps WHERE post_id=?;" - let list_threads = - Caqti_request.collect Caqti_type.int Caqti_type.string - "SELECT thread_id FROM thread_board WHERE board=?;" + let get_threads = + Caqti_request.collect Caqti_type.unit Caqti_type.string + "SELECT thread_id FROM threads;" end let () = @@ -230,7 +199,6 @@ let () = [ Q.create_post_user_table ; Q.create_post_parent_table ; Q.create_thread_table - ; Q.create_thread_board_table ; Q.create_post_replies_table ; Q.create_post_citations_table ; Q.create_post_date_table @@ -269,21 +237,26 @@ let parse_image image = else Ok (Some image) ) -(* TODO: Is this safe? *) -(*TODO fix bad link if post in other thread*) +(*TODO switch to markdown !*) +(* insert html into the comment, and keep tracks of citations : + -wraps lines starting with ">" with a + -make raw posts uuid into links + (*TODO fix bad link if post is in other thread*) + -keeps tracks of every post cited in this comment + - add
at each line *) let parse_comment comment = let handle_word w = let trim_w = String.trim w in (* '>' is '>' after html_escape *) - match String.starts_with ~prefix:{|>>|} trim_w with - | false -> (w, None) - | true -> ( + if String.starts_with ~prefix:{|>>|} trim_w then let sub_w = String.sub trim_w 8 (String.length trim_w - 8) in match Uuidm.of_string sub_w with | None -> (w, None) | Some _ -> let new_w = Format.sprintf {|%s|} sub_w w in - (new_w, Some sub_w) ) + (new_w, Some sub_w) + else + (w, None) in let handle_line l = let trim_w = String.trim l in @@ -344,46 +317,36 @@ let upload_post post = | Op (thread_data, reply) -> (Some thread_data, reply) | Reply reply -> (None, reply) in - let post_id, parent_id, date, nick, comment, image, tags, citations = - match reply with - | { id - ; parent_id - ; date - ; nick - ; comment - ; image - ; tags - ; replies = _replies - ; citations - } -> - (id, parent_id, date, nick, comment, image, tags, citations) + let { id; parent_id; date; nick; comment; image; tags; citations; _ } = + reply in - let^ _res_post_id = Db.exec Q.upload_post_id (post_id, nick) in - let^ _res_comment = Db.exec Q.upload_post_comment (post_id, comment) in - let^ _res_date = Db.exec Q.upload_post_date (post_id, date) in - let^ _res_thread = Db.exec Q.upload_to_thread (parent_id, post_id) in - let^ _res_image = + let^ () = Db.exec Q.upload_post_id (id, nick) in + let^ () = Db.exec Q.upload_post_comment (id, comment) in + let^ () = Db.exec Q.upload_post_date (id, date) in + let^ () = Db.exec Q.upload_to_thread (parent_id, id) in + let^ () = match image with | None -> Ok () | Some (image_name, image_content, alt) -> - Db.exec Q.upload_post_image (post_id, image_name, image_content, alt) + Db.exec Q.upload_post_image (id, image_name, image_content, alt) in - let^ _res_parent = Db.exec Q.upload_post_parent (post_id, parent_id) in - let^ _res_tags = + (* what is parent and why do i need it again? TODO TODO *) + let^ () = Db.exec Q.upload_post_parent (id, parent_id) in + let^ () = match List.find_opt Result.is_error - (List.map (fun tag -> Db.exec Q.upload_post_tag (post_id, tag)) tags) + (List.map (fun tag -> Db.exec Q.upload_post_tag (id, tag)) tags) with | Some (Error e) -> Error e | Some _ -> assert false | None -> Ok () in - let^ _res_citations = + let^ () = match List.find_opt Result.is_error (List.map - (fun cited_id -> Db.exec Q.upload_post_reply (cited_id, post_id)) + (fun cited_id -> Db.exec Q.upload_post_reply (cited_id, id)) citations ) with | Some (Error e) -> Error e @@ -391,27 +354,18 @@ let upload_post post = | None -> Ok () in match thread_data with - | None -> Ok post_id - | Some thread_data -> ( - match thread_data with - | { board; subject; lng; lat } -> - let^ _res_board = - Db.exec Q.upload_thread_board (post_id, int_of_board board) - in - let^ _res_gps = Db.exec Q.upload_post_gps (post_id, lat, lng) in - let^ _res_subject = Db.exec Q.upload_post_subject (post_id, subject) in - Ok post_id ) + | None -> Ok id + | Some { subject; lng; lat } -> + let^ () = Db.exec Q.upload_post_gps (id, lat, lng) in + let^ () = Db.exec Q.upload_post_subject (id, subject) in + Ok id let build_reply ~comment ?image ~tags ?parent_id nick = let comment = Dream.html_escape comment in let tags = Dream.html_escape tags in let id = Uuidm.to_string (Uuidm.v4_gen random_state ()) in (* parent_id is None if this reply is supposed to be a new thread *) - let parent_id = - match parent_id with - | Some parent_id -> parent_id - | None -> id - in + let parent_id = Option.value parent_id ~default:id in if Option.is_none (Uuidm.of_string parent_id) then Error "invalid thread id" else if String.length comment > 10000 then @@ -441,7 +395,7 @@ let build_reply ~comment ?image ~tags ?parent_id nick = in Ok reply -let build_op ~comment ?image ~tags ~subject ~lat ~lng ~board nick = +let build_op ~comment ?image ~tags ~subject ~lat ~lng nick = let subject = Dream.html_escape subject in (* TODO latlng validation? *) let is_valid_latlng = true in @@ -450,7 +404,7 @@ let build_op ~comment ?image ~tags ~subject ~lat ~lng ~board nick = else if String.length subject > 600 then Error "Invalid subject" else - let thread_data = { board; subject; lng; lat } in + let thread_data = { subject; lng; lat } in let* reply = match image with | Some image -> build_reply ~comment ~image ~tags nick @@ -464,8 +418,8 @@ let make_reply ~comment ?image ~tags ~parent_id nick = let post = Reply reply in upload_post post -let make_op ~comment ?image ~tags ~subject ~lat ~lng ~board nick = - let* op = build_op ~comment ?image ~tags ~subject ~lat ~lng ~board nick in +let make_op ~comment ?image ~tags ~subject ~lat ~lng nick = + let* op = build_op ~comment ?image ~tags ~subject ~lat ~lng nick in upload_post op let get_post_image_content post_id = diff --git a/src/babillard_page.eml.html b/src/babillard_page.eml.html index 930bc04..ea47710 100644 --- a/src/babillard_page.eml.html +++ b/src/babillard_page.eml.html @@ -1,17 +1,13 @@ -let f ~board request = -%let board = Format.asprintf "%a" Babillard.pp_board board in +let f request = -
> <%s Format.sprintf "Babillard is love" %> -
% begin match Dream.session "nick" request with % | None -> % | Some _nick -> -%let url = Format.sprintf "/%s/new_thread" board in ->[New Thread] +[New Thread] % end;
diff --git a/src/bindings.ml b/src/bindings.ml index e0b7585..84ebde6 100644 --- a/src/bindings.ml +++ b/src/bindings.ml @@ -13,5 +13,5 @@ let ( let^ ) o f = let ( let* ) o f = match o with - | Error e -> Error (Format.sprintf "%s" e) + | Error e -> Error e | Ok x -> f x diff --git a/src/content/assets/css/style.css b/src/content/assets/css/style.css index c799286..04c233c 100644 --- a/src/content/assets/css/style.css +++ b/src/content/assets/css/style.css @@ -32,7 +32,7 @@ blockquote.blockquote { margin: 5px 5px 5px 5px; border: 2px solid #FFB300; padding: 2px; - display:table; + display: table; } .postInfo { @@ -74,7 +74,7 @@ blockquote.blockquote { margin: 5px 5px 5px 5px; border: 2px solid #FFB300; padding: 2px; - display:table; + display: table; width: 500px; } diff --git a/src/js/js_map.ml b/src/js/js_map.ml index 9ba0e3f..ce6ed97 100644 --- a/src/js/js_map.ml +++ b/src/js/js_map.ml @@ -119,11 +119,6 @@ module Geolocalize = struct end module Marker = struct - let board = - let board_div = Jv.get Jv.global "board" in - Jv.to_string - (Jv.call board_div "getAttribute" [| Jv.of_string "data-board" |]) - (*todo do this in js_babillard*) let marker_on_click thread_preview thread_id _e = log "marker_on_click@."; @@ -131,7 +126,7 @@ module Marker = struct let thread_preview_div = Jv.get Jv.global "thread_preview_div" in ignore @@ Jv.set thread_preview_div "innerHTML" thread_preview; let thread_link = Jv.get Jv.global "thread_link" in - let link = Format.sprintf "/%s/%s" board thread_id in + let link = Format.sprintf "/babillard/%s" thread_id in ignore @@ Jv.set thread_link "href" (Jv.of_string link); ignore @@ Jv.set thread_link "innerText" (Jv.of_string "[View Thread]"); let _ = Js_pretty_post.make_pretty () in @@ -173,7 +168,7 @@ module Marker = struct let () = log "fetch thread geojson@."; let window = Jv.get Jv.global "window" in - let link = Jv.of_string (Format.sprintf "/%s/markers" board) in + let link = Jv.of_string "/babillard/markers" in let fetchfutur = Jv.call window "fetch" [| link |] in ignore @@ Jv.call fetchfutur "then" [| Jv.repr markers_handle_response |]; () diff --git a/src/newthread_page.eml.html b/src/newthread_page.eml.html index e2d7dcb..97dade9 100644 --- a/src/newthread_page.eml.html +++ b/src/newthread_page.eml.html @@ -1,13 +1,10 @@ -let f ~board request = -%let board = Format.asprintf "%a" Babillard.pp_board board in -%let url = Format.sprintf "/%s/new_thread" board in +let f request = % begin match Dream.session "nick" request with % | None -> Login to make a new thread. % | Some _nick ->
Click the map to make a new thread:
-
>
@@ -16,7 +13,7 @@ Login to make a new thread.
-<%s! Dream.form_tag ~action:url ~enctype:`Multipart_form_data request %> +<%s! Dream.form_tag ~action:"/babillard/new_thread" ~enctype:`Multipart_form_data request %> diff --git a/src/permap.ml b/src/permap.ml index cf39654..454f444 100644 --- a/src/permap.ml +++ b/src/permap.ml @@ -148,20 +148,18 @@ let post_image request = | Ok image -> Dream.respond ~headers:[ ("Content-Type", "image") ] image | Error _ -> Dream.empty `Not_Found -let markers ~board request = - let markers = Pp_babillard.get_markers board in +let markers request = + let markers = Pp_babillard.get_markers () in match markers with | Ok markers -> Dream.respond ~headers:[ ("Content-Type", "application/json") ] markers | Error e -> render_unsafe e request -let babillard_get ~board request = - render_unsafe (Babillard_page.f ~board request) request +let babillard_get request = render_unsafe (Babillard_page.f request) request -let newthread_get ~board request = - render_unsafe (Newthread_page.f ~board request) request +let newthread_get request = render_unsafe (Newthread_page.f request) request -let newthread_post ~board request = +let newthread_post request = match Dream.session "nick" request with | None -> render_unsafe "Not logged in" request | Some nick -> ( @@ -181,19 +179,15 @@ let newthread_post ~board request = | Some lat, Some lng -> ( let res = match file with - | [] -> - Babillard.make_op ~comment ~lat ~lng ~subject ~tags ~board nick + | [] -> Babillard.make_op ~comment ~lat ~lng ~subject ~tags nick | _ :: _ :: _ -> Error "More than one image" | [ (image_name, image_content) ] -> let image = (image_name, image_content, alt) in - Babillard.make_op ~comment ~image ~lat ~lng ~subject ~tags ~board - nick + Babillard.make_op ~comment ~image ~lat ~lng ~subject ~tags nick in match res with | Ok thread_id -> - let adress = - Format.asprintf "/%a/%s" Babillard.pp_board board thread_id - in + let adress = Format.asprintf "/babillard/%s" thread_id in Dream.respond ~status:`See_Other ~headers:[ ("Location", adress) ] "Your thread was posted!" @@ -282,11 +276,11 @@ let () = ; Dream.get "/profile" profile_get ; Dream.post "/profile" profile_post ; Dream.get "/thread_view/:thread_id" thread_view - ; Dream.get "/babillard/markers" (markers ~board:Babillard) + ; Dream.get "/babillard/markers" markers ; Dream.get "/post_pic/:post_id" post_image - ; Dream.get "/babillard" (babillard_get ~board:Babillard) - ; Dream.get "/babillard/new_thread" (newthread_get ~board:Babillard) - ; Dream.post "/babillard/new_thread" (newthread_post ~board:Babillard) + ; Dream.get "/babillard" babillard_get + ; Dream.get "/babillard/new_thread" newthread_get + ; Dream.post "/babillard/new_thread" newthread_post ; Dream.get "/babillard/:thread_id" thread_get ; Dream.post "/reply/:thread_id" reply_post ; Dream.get "/post_pic/:post_id" post_image diff --git a/src/pp_babillard.ml b/src/pp_babillard.ml index 85195df..c1702f5 100644 --- a/src/pp_babillard.ml +++ b/src/pp_babillard.ml @@ -126,42 +126,46 @@ let preview_thread thread_id = Ok thread_preview let view_thread thread_id = - let^? _ = Db.find_opt Q.is_thread thread_id in - 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 - 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 + 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 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 + 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 posts = - List.map Result.get_ok (List.filter Result.is_ok view_posts) + | 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 = - 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 + {|
%s @@ -171,14 +175,12 @@ let view_thread thread_id =
|} - subject posts - in - Ok thread_view ) + subject posts + in + Ok thread_view ) -let get_markers board = - let^ thread_id_list = - Db.fold Q.list_threads List.cons (int_of_board board) [] - in +let get_markers () = + let^ thread_id_list = Db.fold Q.get_threads List.cons () [] in let markers_res = List.map (fun thread_id ->