From c91623050ed12ae08e65ac7ff827d4184a6de7ee Mon Sep 17 00:00:00 2001 From: Swrup Date: Tue, 22 Feb 2022 00:01:35 +0100 Subject: [PATCH] little fix --- src/babillard.ml | 26 ++++++++++++-------------- src/db.ml | 2 +- src/dune | 30 +++++++++++++++--------------- src/permap.ml | 10 +++++----- src/pp_babillard.ml | 8 +++----- 5 files changed, 36 insertions(+), 40 deletions(-) diff --git a/src/babillard.ml b/src/babillard.ml index 4a7efd0..0d962e0 100644 --- a/src/babillard.ml +++ b/src/babillard.ml @@ -29,7 +29,7 @@ let unwrap_list f ids = match res with | None -> Ok (List.map Result.get_ok l) | Some (Ok _) -> assert false - | Some (Error e) -> Error e + | Some (Error _e as error) -> error module Q = struct let create_post_user_table = @@ -48,25 +48,21 @@ module Q = struct (* map thread and reply to the thread *) let create_thread_post_table = Caqti_request.exec Caqti_type.unit - "CREATE TABLE IF NOT EXISTS thread_post (thread_id TEXT, post_id TEXT,\n\ - \ FOREIGN KEY(thread_id) REFERENCES post_user(post_id) ON \ - DELETE CASCADE,\n\ - \ FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON \ - DELETE CASCADE);" + "CREATE TABLE IF NOT EXISTS thread_post (thread_id TEXT, post_id TEXT, \ + FOREIGN KEY(thread_id) REFERENCES post_user(post_id) ON DELETE CASCADE, \ + FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);" let create_post_replies_table = Caqti_request.exec Caqti_type.unit "CREATE TABLE IF NOT EXISTS post_replies (post_id TEXT, reply_id TEXT, \ - FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE,\n\ - \ FOREIGN KEY(reply_id) REFERENCES post_user(post_id) ON DELETE \ - CASCADE);" + FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE, \ + FOREIGN KEY(reply_id) REFERENCES post_user(post_id) ON DELETE CASCADE);" let create_post_citations_table = Caqti_request.exec Caqti_type.unit "CREATE TABLE IF NOT EXISTS post_citations (post_id TEXT, cited_id TEXT, \ - FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE,\n\ - \ FOREIGN KEY(cited_id) REFERENCES post_user(post_id) ON DELETE \ - CASCADE);" + FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE, \ + FOREIGN KEY(cited_id) REFERENCES post_user(post_id) ON DELETE CASCADE);" let create_post_date_table = Caqti_request.exec Caqti_type.unit @@ -338,8 +334,10 @@ let upload_post ?image_content post = ( Db.exec Q.upload_image_info (id, name, alt) , Db.exec Q.upload_image_content (id, content) ) ) in - let^ _ = unwrap_list (fun tag -> Db.exec Q.upload_post_tag (id, tag)) tags in - let^ _ = + let^ _unit_list = + unwrap_list (fun tag -> Db.exec Q.upload_post_tag (id, tag)) tags + in + let^ _unit_list = unwrap_list (fun cited_id -> Db.exec Q.upload_post_reply (cited_id, id)) citations diff --git a/src/db.ml b/src/db.ml index 1429ccb..d70600d 100644 --- a/src/db.ml +++ b/src/db.ml @@ -21,7 +21,7 @@ let () = Caqti_request.exec Caqti_type.unit "PRAGMA foreign_keys = ON;" in if Result.is_error (Db.exec set_foreign_keys_on ()) then - Dream.error (fun log -> log "can't et foreign_keys on") + Dream.error (fun log -> log "can't set foreign_keys on") (* TODO do image validation: length and MIME types with conan*) (* TODO do the same for text input: check length, forbidden chars and have a forbidden words filter*) diff --git a/src/dune b/src/dune index 552b159..ce95640 100644 --- a/src/dune +++ b/src/dune @@ -4,11 +4,11 @@ app babillard babillard_page - catalog_page - delete_page bindings + catalog_page content db + delete_page login newthread_page permap @@ -37,6 +37,12 @@ (preprocess (pps lwt_ppx))) +(rule + (targets babillard_page.ml) + (deps babillard_page.eml.html) + (action + (run dream_eml %{deps} --workspace %{workspace_root}))) + (rule (targets catalog_page.ml) (deps catalog_page.eml.html) @@ -50,14 +56,14 @@ (run dream_eml %{deps} --workspace %{workspace_root}))) (rule - (targets template.ml) - (deps template.eml.html) + (targets login.ml) + (deps login.eml.html) (action (run dream_eml %{deps} --workspace %{workspace_root}))) (rule - (targets login.ml) - (deps login.eml.html) + (targets newthread_page.ml) + (deps newthread_page.eml.html) (action (run dream_eml %{deps} --workspace %{workspace_root}))) @@ -68,8 +74,8 @@ (run dream_eml %{deps} --workspace %{workspace_root}))) (rule - (targets babillard_page.ml) - (deps babillard_page.eml.html) + (targets template.ml) + (deps template.eml.html) (action (run dream_eml %{deps} --workspace %{workspace_root}))) @@ -79,12 +85,6 @@ (action (run dream_eml %{deps} --workspace %{workspace_root}))) -(rule - (targets newthread_page.ml) - (deps newthread_page.eml.html) - (action - (run dream_eml %{deps} --workspace %{workspace_root}))) - (rule (targets user_profile.ml) (deps user_profile.eml.html) @@ -95,8 +95,8 @@ (target content.ml) (deps (source_tree content) - (file content/assets/js/js_catalog.js) (file content/assets/js/js_babillard.js) + (file content/assets/js/js_catalog.js) (file content/assets/js/js_newthread.js) (file content/assets/js/js_thread.js)) (action diff --git a/src/permap.ml b/src/permap.ml index be2acd1..8bc6648 100644 --- a/src/permap.ml +++ b/src/permap.ml @@ -276,6 +276,9 @@ let routes = [ get_ "/" babillard_get ; get_ "/about" about ; get_ "/assets/**" (Dream.static ~loader:asset_loader "") + ; get_ "/catalog" catalog + ; get_ "/delete/:post_id" delete_get + ; post "/delete/:post_id" delete_post ; get_ "/img/:post_id" post_image ; get_ "/login" login_get ; post "/login" login_post @@ -286,14 +289,11 @@ let routes = ; get_ "/post_pic/:post_id" post_image ; get_ "/profile" profile_get ; post "/profile" profile_post + ; get_ "/thread/:thread_id" thread_get + ; post "/thread/:thread_id" reply_post ; get_ "/user" user ; get_ "/user/:user" user_profile ; get_ "/user/:user/avatar" avatar_image - ; get_ "/thread/:thread_id" thread_get - ; post "/thread/:thread_id" reply_post - ; get_ "/catalog" catalog - ; get_ "/delete/:post_id" delete_get - ; post "/delete/:post_id" delete_post ] @ if App.open_registration then diff --git a/src/pp_babillard.ml b/src/pp_babillard.ml index ecac00e..22a1df9 100644 --- a/src/pp_babillard.ml +++ b/src/pp_babillard.ml @@ -143,12 +143,10 @@ let pp_thread_preview fmt op = let catalog_content () = let^ ids = Db.collect_list Q.get_threads () in let* ops = get_ops ids in - let previews = List.map (Format.asprintf "%a" pp_thread_preview) ops in Ok (Format.asprintf "%a" - (Format.pp_print_list ~pp_sep:Format.pp_print_space - Format.pp_print_string ) - previews ) + (Format.pp_print_list ~pp_sep:Format.pp_print_space pp_thread_preview) + ops ) let pp_thread fmt op posts = let thread_data, _post = op in @@ -210,7 +208,7 @@ let get_markers () = Format.asprintf "[%a]" (Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt ",") - (fun fmt op -> pp_marker fmt op) ) + pp_marker ) ops in Ok markers