%s
open Db exception Invalid_post of string type op = { id : string ; date : int ; nick : string ; subject : string ; comment : string ; image : string * string ; tags : string list ; longitude : float ; latitude : float ; replies : string list ; citations : string list } type reply = { id : string ; parent_id : string ; date : int ; nick : string ; comment : string ; image : (string * string) option ; tags : string list ; replies : string list ; citations : string list } type post = | Op of op | Reply of reply module Q = struct let create_post_user_table = Caqti_request.exec Caqti_type.unit "CREATE TABLE IF NOT EXISTS post_user (post_id TEXT, nick TEXT, PRIMARY \ KEY(post_id), FOREIGN KEY(nick) REFERENCES user(nick));" (* post_id -> OP's post_id *) let create_post_parent_table = Caqti_request.exec Caqti_type.unit "CREATE TABLE IF NOT EXISTS post_parent (post_id TEXT, parent_id TEXT, \ FOREIGN KEY(post_id) REFERENCES post_user(post_id),\n\ \ FOREIGN KEY(parent_id) REFERENCES post_user(post_id));" let create_thread_table = Caqti_request.exec Caqti_type.unit "CREATE TABLE IF NOT EXISTS threads (thread_id TEXT, post_id TEXT,\n\ \ FOREIGN KEY(thread_id) REFERENCES post_user(post_id),\n\ \ FOREIGN KEY(post_id) REFERENCES post_user(post_id));" 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),\n\ \ FOREIGN KEY(reply_id) REFERENCES post_user(post_id));" 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),\n\ \ FOREIGN KEY(cited_id) REFERENCES post_user(post_id));" let create_post_date_table = Caqti_request.exec Caqti_type.unit "CREATE TABLE IF NOT EXISTS post_date (post_id TEXT, date INT, FOREIGN \ KEY(post_id) REFERENCES post_user(post_id));" let create_post_comment_table = Caqti_request.exec Caqti_type.unit "CREATE TABLE IF NOT EXISTS post_comment (post_id TEXT, comment TEXT, \ FOREIGN KEY(post_id) REFERENCES post_user(post_id));" let create_post_image_table = Caqti_request.exec Caqti_type.unit "CREATE TABLE IF NOT EXISTS post_image (post_id TEXT, image_name TEXT, \ image_content, FOREIGN KEY(post_id) REFERENCES post_user(post_id));" let create_post_gps_table = Caqti_request.exec Caqti_type.unit "CREATE TABLE IF NOT EXISTS post_gps (post_id TEXT, lat FLOAT, lng FLOAT ,\n\ \ FOREIGN KEY(post_id) REFERENCES post_user(post_id));" let create_post_subject_table = Caqti_request.exec Caqti_type.unit "CREATE TABLE IF NOT EXISTS post_subject (post_id TEXT, subject TEXT, \ FOREIGN KEY(post_id) REFERENCES post_user(post_id));" let create_post_tags_table = Caqti_request.exec Caqti_type.unit "CREATE TABLE IF NOT EXISTS post_tags (post_id TEXT, tag TEXT, FOREIGN \ KEY(post_id) REFERENCES post_user(post_id));" let upload_post_id = Caqti_request.exec Caqti_type.(tup2 string string) "INSERT INTO post_user VALUES (?,?);" let upload_post_gps = Caqti_request.exec Caqti_type.(tup3 string float float) "INSERT INTO post_gps VALUES (?,?,?);" let upload_post_image = Caqti_request.exec Caqti_type.(tup3 string string string) "INSERT INTO post_image VALUES (?,?,?);" let upload_post_reply = Caqti_request.exec Caqti_type.(tup2 string string) "INSERT INTO post_replies VALUES (?,?);" let upload_post_comment = Caqti_request.exec Caqti_type.(tup2 string string) "INSERT INTO post_comment VALUES (?,?);" let upload_post_subject = Caqti_request.exec Caqti_type.(tup2 string string) "INSERT INTO post_subject VALUES (?,?);" let upload_post_tag = Caqti_request.exec Caqti_type.(tup2 string string) "INSERT INTO post_tags VALUES (?,?);" let upload_post_date = Caqti_request.exec Caqti_type.(tup2 string int) "INSERT INTO post_date VALUES (?,?);" let upload_to_thread = Caqti_request.exec Caqti_type.(tup2 string string) "INSERT INTO threads VALUES (?,?);" let upload_post_parent = Caqti_request.exec Caqti_type.(tup2 string string) "INSERT INTO post_parent VALUES (?,?);" let get_post_nick = Caqti_request.find Caqti_type.string Caqti_type.string "SELECT nick FROM post_user WHERE post_id=?;" let get_post_comment = Caqti_request.find Caqti_type.string Caqti_type.string "SELECT comment FROM post_comment WHERE post_id=?;" let get_post_image_content = Caqti_request.find_opt Caqti_type.string Caqti_type.string "SELECT image_content FROM post_image WHERE post_id=?;" let get_post_image_name = Caqti_request.find_opt Caqti_type.string Caqti_type.string "SELECT image_name FROM post_image WHERE post_id=?;" let get_post_tags = Caqti_request.collect Caqti_type.string Caqti_type.string "SELECT tag FROM post_tags WHERE post_id=?;" let get_post_date = Caqti_request.find Caqti_type.string Caqti_type.int "SELECT date FROM post_date WHERE post_id=?;" let get_post_citations = Caqti_request.collect Caqti_type.string Caqti_type.string "SELECT post_id FROM post_citations WHERE reply_id=?;" let get_post_replies = Caqti_request.collect Caqti_type.string Caqti_type.string "SELECT reply_id FROM post_replies WHERE post_id=?;" let get_thread_posts = Caqti_request.collect Caqti_type.string Caqti_type.string "SELECT 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_post_subject = Caqti_request.find_opt Caqti_type.string Caqti_type.string "SELECT subject FROM post_subject WHERE post_id=?;" let get_post_gps = Caqti_request.find_opt Caqti_type.string Caqti_type.(tup2 float float) "SELECT lat, lng FROM post_gps WHERE post_id=?;" let list_thread_ids = Caqti_request.collect Caqti_type.unit Caqti_type.string "SELECT thread_id FROM threads;" end let () = let tables = [ Q.create_post_user_table ; Q.create_post_parent_table ; Q.create_thread_table ; Q.create_post_replies_table ; Q.create_post_citations_table ; Q.create_post_date_table ; Q.create_post_comment_table ; Q.create_post_image_table ; Q.create_post_gps_table ; Q.create_post_subject_table ; Q.create_post_tags_table ] in if List.exists Result.is_error (List.map (fun query -> Db.exec query ()) tables) then Dream.warning (fun log -> log "can't create table") (* TODO should I escape html or smthing ?*) let parse_comment comment = let words = String.split_on_char ' ' comment in let cited_posts, words = List.fold_left (fun (acc_cited, acc_posts) w -> match String.starts_with ~prefix:">>" w with | false -> (acc_cited, acc_posts @ [ w ]) | true -> ( let sub_w = String.sub w 2 (String.length w - 2) in match Uuidm.of_string sub_w with | None -> (acc_cited, acc_posts @ [ w ]) | Some _ -> let new_w = Format.sprintf {|%s|} sub_w w in (acc_cited @ [ sub_w ], acc_posts @ [ new_w ]) ) ) ([], []) words in let comment = String.concat (String.make 1 ' ') words in (* remove duplicate *) let cited_posts = List.sort_uniq (fun _ _ -> 0) cited_posts in (comment, cited_posts) let view_post post_id = let res_nick = Db.find Q.get_post_nick post_id in let res_comment = Db.find Q.get_post_comment post_id in let res_date = Db.find Q.get_post_date post_id in let res_image_name = Db.find_opt Q.get_post_image_name post_id in let res_tags = Db.fold Q.get_post_tags (fun tag acc -> tag :: acc) post_id [] in let res_replies = Db.fold Q.get_post_replies (fun reply_id acc -> reply_id :: acc) post_id [] in (* get more stuff for OP *) let res_subject = Db.find_opt Q.get_post_subject post_id in let res_latlng = Db.find_opt Q.get_post_gps post_id in (* TODO clean taht idk urghh.. *) let res0 = match List.find_opt Result.is_error [ res_nick; res_comment ] with | Some (Error e) -> Error e | Some (Ok _) -> assert false | None -> Ok () in let res1 = match List.find_opt Result.is_error [ res_image_name; res_subject ] with | Some (Error e) -> Error e | Some (Ok _) -> assert false | None -> Ok () in let res2 = match res_latlng with | Ok _ -> Ok () | Error e -> Error e in let res3 = match List.find_opt Result.is_error [ res_tags; res_replies ] with | Some (Error e) -> Error e | Some (Ok _) -> assert false | None -> Ok () in let res4jpp = match res_date with | Ok _ -> Ok () | Error e -> Error e in match List.find_opt Result.is_error [ res0; res1; res2; res3; res4jpp ] with | Some (Error e) -> Error (Format.sprintf "db error: %s" (Caqti_error.show e)) | None -> ( match ( res_nick , res_comment , res_image_name , res_date , res_subject , res_latlng , res_tags , res_replies ) with | ( Ok nick , Ok comment , Ok image_name , Ok date , Ok _subject , Ok _latlng , Ok _tags , Ok replies ) -> let image_view = match image_name with | Some image_name -> (*TODO thumbnails *) Format.sprintf {|
|} image_name post_id post_id | None -> "" in let replies_view = {|%s