refactor
This commit is contained in:
zapashcanon
parent
190d086206
commit
ce7bb9d386
9 changed files with 442 additions and 500 deletions
357
src/babillard.ml
357
src/babillard.ml
|
|
@ -1,5 +1,6 @@
|
|||
open Db
|
||||
open Syntax
|
||||
open Caqti_request.Infix
|
||||
open Caqti_type
|
||||
|
||||
type moderation_action =
|
||||
| Ignore
|
||||
|
|
@ -40,150 +41,50 @@ type t =
|
|||
| Op of thread_data * post
|
||||
| Post of post
|
||||
|
||||
module Q = struct
|
||||
open Caqti_request.Infix
|
||||
open Caqti_type
|
||||
|
||||
let create_post_user_table =
|
||||
(unit ->. unit)
|
||||
"CREATE TABLE IF NOT EXISTS post_user (post_id TEXT, user_id TEXT, \
|
||||
PRIMARY KEY(post_id), FOREIGN KEY(user_id) REFERENCES user(user_id) ON \
|
||||
DELETE CASCADE)"
|
||||
|
||||
(* one row for each thread, with thread's data *)
|
||||
let create_thread_info_table =
|
||||
(unit ->. unit)
|
||||
"CREATE TABLE IF NOT EXISTS thread_info (thread_id TEXT, subject TEXT, \
|
||||
lat FLOAT, lng FLOAT, FOREIGN KEY(thread_id) REFERENCES \
|
||||
post_user(post_id) ON DELETE CASCADE)"
|
||||
|
||||
(* map thread and reply to the thread *)
|
||||
let create_thread_post_table =
|
||||
(unit ->. unit)
|
||||
"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 =
|
||||
(unit ->. 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, \
|
||||
FOREIGN KEY(reply_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
||||
|
||||
let create_post_citations_table =
|
||||
(unit ->. 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, \
|
||||
FOREIGN KEY(cited_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
||||
|
||||
let create_post_date_table =
|
||||
(unit ->. unit)
|
||||
"CREATE TABLE IF NOT EXISTS post_date (post_id TEXT, date FLOAT, FOREIGN \
|
||||
KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
||||
|
||||
let create_post_comment_table =
|
||||
(unit ->. unit)
|
||||
"CREATE TABLE IF NOT EXISTS post_comment (post_id TEXT, comment TEXT, \
|
||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
||||
|
||||
let create_post_tags_table =
|
||||
(unit ->. unit)
|
||||
"CREATE TABLE IF NOT EXISTS post_tags (post_id TEXT, tag TEXT, FOREIGN \
|
||||
KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
||||
|
||||
let create_report_table =
|
||||
(unit ->. unit)
|
||||
"CREATE TABLE IF NOT EXISTS report (user_id TEXT, reason TEXT, date \
|
||||
FLOAT,post_id TEXT, FOREIGN KEY(post_id) REFERENCES post_user(post_id) \
|
||||
ON DELETE CASCADE, FOREIGN KEY(user_id) REFERENCES user(user_id) ON \
|
||||
DELETE CASCADE)"
|
||||
|
||||
let upload_report =
|
||||
(tup4 string string float string ->. unit)
|
||||
"INSERT INTO report VALUES (?,?,?,?)"
|
||||
|
||||
let ignore_report = (string ->. unit) "DELETE FROM report WHERE post_id=?"
|
||||
|
||||
let get_reports =
|
||||
(unit ->* tup4 string string float string) "SELECT * FROM report"
|
||||
|
||||
let upload_post_id =
|
||||
(tup2 string string ->. unit) "INSERT INTO post_user VALUES (?,?)"
|
||||
|
||||
let upload_thread_info =
|
||||
(tup4 string string float float ->. unit)
|
||||
"INSERT INTO thread_info VALUES (?,?,?,?)"
|
||||
|
||||
let upload_thread_post =
|
||||
(tup2 string string ->. unit) "INSERT INTO thread_post VALUES (?,?)"
|
||||
|
||||
let upload_post_reply =
|
||||
(tup2 string string ->. unit) "INSERT INTO post_replies VALUES (?,?)"
|
||||
|
||||
let upload_post_comment =
|
||||
(tup2 string string ->. unit) "INSERT INTO post_comment VALUES (?,?)"
|
||||
|
||||
let upload_post_tag =
|
||||
(tup2 string string ->. unit) "INSERT INTO post_tags VALUES (?,?)"
|
||||
|
||||
let upload_post_date =
|
||||
(tup2 string float ->. unit) "INSERT INTO post_date VALUES (?,?)"
|
||||
|
||||
let get_post_user_id =
|
||||
(string ->! string) "SELECT user_id FROM post_user WHERE post_id=?"
|
||||
|
||||
let get_post_comment =
|
||||
(string ->! string) "SELECT comment FROM post_comment WHERE post_id=?"
|
||||
|
||||
let get_post_tags =
|
||||
(string ->* string) "SELECT tag FROM post_tags WHERE post_id=?"
|
||||
|
||||
let get_post_date =
|
||||
(string ->! float) "SELECT date FROM post_date WHERE post_id=?"
|
||||
|
||||
let get_post_citations =
|
||||
(string ->* string) "SELECT post_id FROM post_citations WHERE post_id=?"
|
||||
|
||||
let get_post_replies =
|
||||
(string ->* string) "SELECT reply_id FROM post_replies WHERE post_id=?"
|
||||
|
||||
let get_thread_posts =
|
||||
(string ->* string) "SELECT post_id FROM thread_post WHERE thread_id=?"
|
||||
|
||||
let count_thread_posts =
|
||||
(string ->! int) "SELECT COUNT(post_id) FROM thread_post WHERE thread_id=?"
|
||||
|
||||
let get_is_thread =
|
||||
(string ->! string)
|
||||
"SELECT thread_id FROM thread_info WHERE thread_id=? LIMIT 1"
|
||||
|
||||
let get_is_post =
|
||||
(string ->! string) "SELECT post_id FROM post_user WHERE post_id=? LIMIT 1"
|
||||
|
||||
let get_post_thread =
|
||||
(string ->! string)
|
||||
"SELECT thread_id FROM thread_post WHERE post_id=? LIMIT 1"
|
||||
|
||||
let get_thread_info =
|
||||
(string ->! tup3 string float float)
|
||||
"SELECT subject,lat,lng FROM thread_info WHERE thread_id=?"
|
||||
|
||||
let get_threads = (unit ->* string) "SELECT thread_id FROM thread_info"
|
||||
|
||||
let delete_post = (string ->. unit) "DELETE FROM post_user WHERE post_id=?"
|
||||
end
|
||||
|
||||
let () =
|
||||
let tables =
|
||||
[| Q.create_post_user_table
|
||||
; Q.create_thread_info_table
|
||||
; Q.create_thread_post_table
|
||||
; Q.create_post_replies_table
|
||||
; Q.create_post_citations_table
|
||||
; Q.create_post_date_table
|
||||
; Q.create_post_comment_table
|
||||
; Q.create_post_tags_table
|
||||
; Q.create_report_table
|
||||
[| (unit ->. unit)
|
||||
"CREATE TABLE IF NOT EXISTS post_user (post_id TEXT, user_id TEXT, \
|
||||
PRIMARY KEY(post_id), FOREIGN KEY(user_id) REFERENCES user(user_id) \
|
||||
ON DELETE CASCADE)"
|
||||
; (* one row for each thread, with thread's data *)
|
||||
(unit ->. unit)
|
||||
"CREATE TABLE IF NOT EXISTS thread_info (thread_id TEXT, subject \
|
||||
TEXT, lat FLOAT, lng FLOAT, FOREIGN KEY(thread_id) REFERENCES \
|
||||
post_user(post_id) ON DELETE CASCADE)"
|
||||
; (* map thread and reply to the thread *)
|
||||
(unit ->. unit)
|
||||
"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)"
|
||||
; (unit ->. 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, FOREIGN KEY(reply_id) REFERENCES post_user(post_id) ON \
|
||||
DELETE CASCADE)"
|
||||
; (unit ->. 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, FOREIGN KEY(cited_id) REFERENCES post_user(post_id) ON \
|
||||
DELETE CASCADE)"
|
||||
; (unit ->. unit)
|
||||
"CREATE TABLE IF NOT EXISTS post_date (post_id TEXT, date FLOAT, \
|
||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE \
|
||||
CASCADE)"
|
||||
; (unit ->. unit)
|
||||
"CREATE TABLE IF NOT EXISTS post_comment (post_id TEXT, comment TEXT, \
|
||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE \
|
||||
CASCADE)"
|
||||
; (unit ->. unit)
|
||||
"CREATE TABLE IF NOT EXISTS post_tags (post_id TEXT, tag TEXT, \
|
||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE \
|
||||
CASCADE)"
|
||||
; (unit ->. unit)
|
||||
"CREATE TABLE IF NOT EXISTS report (user_id TEXT, reason TEXT, date \
|
||||
FLOAT,post_id TEXT, FOREIGN KEY(post_id) REFERENCES \
|
||||
post_user(post_id) ON DELETE CASCADE, FOREIGN KEY(user_id) \
|
||||
REFERENCES user(user_id) ON DELETE CASCADE)"
|
||||
|]
|
||||
in
|
||||
if
|
||||
|
|
@ -191,6 +92,101 @@ let () =
|
|||
(Array.map (fun query -> Db.exec query ()) tables)
|
||||
then Dream.error (fun log -> log "can't create babillard's tables")
|
||||
|
||||
module Q = struct
|
||||
let upload_report =
|
||||
Db.exec
|
||||
@@ (tup4 string string float string ->. unit)
|
||||
"INSERT INTO report VALUES (?,?,?,?)"
|
||||
|
||||
let get_reports =
|
||||
Db.collect_list
|
||||
@@ (unit ->* tup4 string string float string) "SELECT * FROM report"
|
||||
|
||||
let upload_post_id =
|
||||
Db.exec
|
||||
@@ (tup2 string string ->. unit) "INSERT INTO post_user VALUES (?,?)"
|
||||
|
||||
let upload_thread_info =
|
||||
Db.exec
|
||||
@@ (tup4 string string float float ->. unit)
|
||||
"INSERT INTO thread_info VALUES (?,?,?,?)"
|
||||
|
||||
let upload_thread_post =
|
||||
Db.exec
|
||||
@@ (tup2 string string ->. unit) "INSERT INTO thread_post VALUES (?,?)"
|
||||
|
||||
let upload_post_reply =
|
||||
Db.exec
|
||||
@@ (tup2 string string ->. unit) "INSERT INTO post_replies VALUES (?,?)"
|
||||
|
||||
let upload_post_comment =
|
||||
Db.exec
|
||||
@@ (tup2 string string ->. unit) "INSERT INTO post_comment VALUES (?,?)"
|
||||
|
||||
let upload_post_tag =
|
||||
Db.exec
|
||||
@@ (tup2 string string ->. unit) "INSERT INTO post_tags VALUES (?,?)"
|
||||
|
||||
let upload_post_date =
|
||||
Db.exec @@ (tup2 string float ->. unit) "INSERT INTO post_date VALUES (?,?)"
|
||||
|
||||
let get_post_user_id =
|
||||
Db.find
|
||||
@@ (string ->! string) "SELECT user_id FROM post_user WHERE post_id=?"
|
||||
|
||||
let get_post_comment =
|
||||
Db.find
|
||||
@@ (string ->! string) "SELECT comment FROM post_comment WHERE post_id=?"
|
||||
|
||||
let get_post_tags =
|
||||
Db.collect_list
|
||||
@@ (string ->* string) "SELECT tag FROM post_tags WHERE post_id=?"
|
||||
|
||||
let get_post_date =
|
||||
Db.find @@ (string ->! float) "SELECT date FROM post_date WHERE post_id=?"
|
||||
|
||||
let get_post_citations =
|
||||
Db.collect_list
|
||||
@@ (string ->* string) "SELECT post_id FROM post_citations WHERE post_id=?"
|
||||
|
||||
let get_post_replies =
|
||||
Db.collect_list
|
||||
@@ (string ->* string) "SELECT reply_id FROM post_replies WHERE post_id=?"
|
||||
|
||||
let get_thread_posts =
|
||||
Db.collect_list
|
||||
@@ (string ->* string) "SELECT post_id FROM thread_post WHERE thread_id=?"
|
||||
|
||||
let count_thread_posts =
|
||||
Db.find
|
||||
@@ (string ->! int)
|
||||
"SELECT COUNT(post_id) FROM thread_post WHERE thread_id=?"
|
||||
|
||||
let get_is_post =
|
||||
Db.find
|
||||
@@ (string ->! string)
|
||||
"SELECT post_id FROM post_user WHERE post_id=? LIMIT 1"
|
||||
|
||||
let get_post_thread =
|
||||
Db.find
|
||||
@@ (string ->! string)
|
||||
"SELECT thread_id FROM thread_post WHERE post_id=? LIMIT 1"
|
||||
|
||||
let get_thread_info =
|
||||
Db.find
|
||||
@@ (string ->! tup3 string float float)
|
||||
"SELECT subject,lat,lng FROM thread_info WHERE thread_id=?"
|
||||
|
||||
let get_threads =
|
||||
Db.collect_list @@ (unit ->* string) "SELECT thread_id FROM thread_info"
|
||||
|
||||
let delete_post =
|
||||
Db.exec @@ (string ->. unit) "DELETE FROM post_user WHERE post_id=?"
|
||||
end
|
||||
|
||||
let ignore_report =
|
||||
Db.exec @@ (string ->. unit) "DELETE FROM report WHERE post_id=?"
|
||||
|
||||
(*TODO switch to markdown !*)
|
||||
(* insert html into the comment, and keep tracks of citations :
|
||||
-wraps lines starting with ">" with a <span class="quote">
|
||||
|
|
@ -252,28 +248,28 @@ let upload_post ~image post =
|
|||
in
|
||||
let { id; parent_id; date; user_id; comment; tags; citations; _ } = reply in
|
||||
|
||||
let^ () = Db.exec Q.upload_post_id (id, user_id) 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_thread_post (parent_id, id) in
|
||||
let* () = Q.upload_post_id (id, user_id) in
|
||||
let* () = Q.upload_post_comment (id, comment) in
|
||||
let* () = Q.upload_post_date (id, date) in
|
||||
let* () = Q.upload_thread_post (parent_id, id) in
|
||||
let* () =
|
||||
match image with None -> Ok () | Some image -> Image.upload image id
|
||||
in
|
||||
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
|
||||
in
|
||||
let^ () =
|
||||
match thread_data with
|
||||
| None -> Ok ()
|
||||
| Some { subject; lng; lat } ->
|
||||
Db.exec Q.upload_thread_info (id, subject, lat, lng)
|
||||
in
|
||||
Ok id
|
||||
match unwrap_list (fun tag -> Q.upload_post_tag (id, tag)) tags with
|
||||
| Error _e as e -> e
|
||||
| Ok _ -> (
|
||||
match
|
||||
unwrap_list (fun cited_id -> Q.upload_post_reply (cited_id, id)) citations
|
||||
with
|
||||
| Error _e as e -> e
|
||||
| Ok _ ->
|
||||
let* () =
|
||||
match thread_data with
|
||||
| None -> Ok ()
|
||||
| Some { subject; lng; lat } ->
|
||||
Q.upload_thread_info (id, subject, lat, lng)
|
||||
in
|
||||
Ok id )
|
||||
|
||||
let build_reply ~comment ~image_info ~tag_list ?parent_id user_id =
|
||||
let comment = Dream.html_escape comment in
|
||||
|
|
@ -353,22 +349,20 @@ let make_post ~comment ?image_input ~tags ~op_or_reply_data user_id =
|
|||
in
|
||||
upload_post ~image post
|
||||
|
||||
let thread_exist id = Result.is_ok (Db.find Q.get_is_thread id)
|
||||
|
||||
(* true if post is an op too *)
|
||||
let post_exist id = Result.is_ok (Db.find Q.get_is_post id)
|
||||
let post_exist id = Result.is_ok (Q.get_is_post id)
|
||||
|
||||
let get_post id =
|
||||
let^ parent_id = Db.find Q.get_post_thread id in
|
||||
let^ user_id = Db.find Q.get_post_user_id id in
|
||||
let* parent_id = Q.get_post_thread id in
|
||||
let* user_id = Q.get_post_user_id id in
|
||||
let* nick = User.get_nick user_id in
|
||||
let^ comment = Db.find Q.get_post_comment id in
|
||||
let^ date = Db.find Q.get_post_date id in
|
||||
let* comment = Q.get_post_comment id in
|
||||
let* date = Q.get_post_date id in
|
||||
let* image_info = Image.get_info id in
|
||||
|
||||
let^ tags = Db.collect_list Q.get_post_tags id in
|
||||
let^ replies = Db.collect_list Q.get_post_replies id in
|
||||
let^ citations = Db.collect_list Q.get_post_citations id in
|
||||
let* tags = Q.get_post_tags id in
|
||||
let* replies = Q.get_post_replies id in
|
||||
let* citations = Q.get_post_citations id in
|
||||
let reply =
|
||||
{ id
|
||||
; parent_id
|
||||
|
|
@ -385,10 +379,8 @@ let get_post id =
|
|||
Ok reply
|
||||
|
||||
let get_thread_data id =
|
||||
if thread_exist id then
|
||||
let^? subject, lat, lng = Db.find_opt Q.get_thread_info id in
|
||||
Ok { subject; lat; lng }
|
||||
else Error "not an op"
|
||||
let* subject, lat, lng = Q.get_thread_info id in
|
||||
Ok { subject; lat; lng }
|
||||
|
||||
let get_op id =
|
||||
let* thread_data = get_thread_data id in
|
||||
|
|
@ -401,9 +393,7 @@ let get_ops ids = unwrap_list get_op ids
|
|||
|
||||
let try_delete_post ~user_id id =
|
||||
let* post = get_post id in
|
||||
if post.user_id = user_id || User.is_admin user_id then
|
||||
let^ () = Db.exec Q.delete_post id in
|
||||
Ok ()
|
||||
if post.user_id = user_id || User.is_admin user_id then Q.delete_post id
|
||||
else Error "You can only delete your posts"
|
||||
|
||||
let report ~user_id ~reason id =
|
||||
|
|
@ -412,15 +402,10 @@ let report ~user_id ~reason id =
|
|||
else
|
||||
let reason = Dream.html_escape reason in
|
||||
let date = Unix.time () in
|
||||
let^ () = Db.exec Q.upload_report (user_id, reason, date, id) in
|
||||
Ok ()
|
||||
|
||||
let ignore_report id =
|
||||
let^ () = Db.exec Q.ignore_report id in
|
||||
Ok ()
|
||||
Q.upload_report (user_id, reason, date, id)
|
||||
|
||||
let get_reports () =
|
||||
let^ reports = Db.collect_list Q.get_reports () in
|
||||
let* reports = Q.get_reports () in
|
||||
let* posts =
|
||||
unwrap_list (fun (_reporter_id, _reason, _date, id) -> get_post id) reports
|
||||
in
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue