little fix

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\
+      "CREATE TABLE IF NOT EXISTS thread_post (thread_id TEXT, post_id TEXT, \
-      \               FOREIGN KEY(thread_id) REFERENCES post_user(post_id) ON \
+       FOREIGN KEY(thread_id) REFERENCES post_user(post_id) ON DELETE CASCADE, \
-       DELETE CASCADE,\n\
+       FOREIGN KEY(post_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(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE, \
-      \       FOREIGN KEY(reply_id) REFERENCES post_user(post_id) ON DELETE \
+       FOREIGN KEY(reply_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
-       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(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE, \
-      \       FOREIGN KEY(cited_id) REFERENCES post_user(post_id) ON DELETE \
+       FOREIGN KEY(cited_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
-       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^ _unit_list =
-  let^ _ =
+    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

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*)

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)
+ (targets login.ml)
- (deps template.eml.html)
+ (deps login.eml.html)
  (action
   (run dream_eml %{deps} --workspace %{workspace_root})))
 
 (rule
- (targets login.ml)
+ (targets newthread_page.ml)
- (deps login.eml.html)
+ (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)
+ (targets template.ml)
- (deps babillard_page.eml.html)
+ (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

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

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_list ~pp_sep:Format.pp_print_space pp_thread_preview)
-          Format.pp_print_string )
+       ops )
-       previews )
 
 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