open Db

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 op =
  { id : string
  ; board : board
  ; date : int
  ; nick : string
  ; subject : string
  ; comment : string
  ; image : string * 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 * string) option
  ; tags : string list
  ; replies : string list
  ; citations : string list
  }

type post =
  | Op of op
  | Reply of reply

(* ('a option, string) result *)
let ( let** ) o f =
  match o with
  | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
  | Ok None -> Error "db error"
  | Ok (Some x) -> f x

(* ('a, string) result *)
let ( let* ) o f =
  match o with
  | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
  | Ok x -> f x

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_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\
      \         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 TEXT, image_alt TEXT, 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.(tup4 string 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_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)
      "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_info =
    Caqti_request.find_opt Caqti_type.string
      Caqti_type.(tup2 string string)
      "SELECT image_name,image_alt 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=?;"

  let count_thread_posts =
    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;"

  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_threads =
    Caqti_request.collect Caqti_type.int Caqti_type.string
      "SELECT thread_id FROM thread_board WHERE board=?;"
end

let () =
  let tables =
    [ 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
    ; 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")

let parse_image image =
  match image with
  | None -> Ok None
  | Some image -> (
    let image =
      match image with
      | Some image_name, image_content, alt ->
        (Dream.html_escape image_name, image_content, Dream.html_escape alt)
      | None, image_content, alt ->
        (* make up random name if no name was given *)
        let image_name = Uuidm.to_string (Uuidm.v4_gen random_state ()) in
        (image_name, image_content, Dream.html_escape alt)
    in
    match image with
    | _, image_content, alt ->
      if not (is_valid_image image_content) then
        Error "invalid image"
      else if String.length alt > 1000 then
        Error "Image description too long"
      else
        Ok (Some image) )

(* TODO: Is this safe? *)
(*TODO fix bad link if post in other thread*)
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 -> (
      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 {|<a href="#%s">%s</a>|} sub_w w in
        (new_w, Some sub_w) )
  in
  let handle_line l =
    let trim_w = String.trim l in
    (*insert quote*)
    let line =
      match
        String.starts_with ~prefix:{|&gt;|} trim_w
        && not (String.starts_with ~prefix:{|&gt;&gt;|} trim_w)
      with
      | false -> l
      | true -> {|<span class="quote">|} ^ l ^ {|</span>|}
    in
    let words = String.split_on_char ' ' line in
    let words, cited_posts =
      List.fold_left
        (fun (acc_words, acc_cited_posts) w ->
          match handle_word w with
          | w, Some cited_id -> (w :: acc_words, cited_id :: acc_cited_posts)
          | w, None -> (w :: acc_words, acc_cited_posts) )
        ([], []) words
    in
    let words = List.rev words in
    let line =
      Format.asprintf "%a"
        (Format.pp_print_list
           ~pp_sep:(fun fmt () -> Format.fprintf fmt " ")
           Format.pp_print_string )
        words
    in
    (line, cited_posts)
  in

  let comment = String.trim comment in
  let lines = String.split_on_char '\n' comment in
  let lines, cited_posts =
    List.fold_left
      (fun (acc_lines, acc_cited_posts) l ->
        let line, cited_posts = handle_line l in
        (line :: acc_lines, cited_posts @ acc_cited_posts) )
      ([], []) lines
  in
  let lines = List.rev lines in
  (*insert <br>*)
  let comment =
    Format.asprintf "%a"
      (Format.pp_print_list
         ~pp_sep:(fun fmt () -> Format.fprintf fmt "@.<br>")
         Format.pp_print_string )
      lines
  in
  (* remove duplicate cited_id *)
  let cited_posts = List.sort_uniq (fun _ _ -> 1) cited_posts in
  (comment, cited_posts)

let view_post ?is_thread_preview post_id =
  let* nick = Db.find Q.get_post_nick post_id in
  let* comment = Db.find Q.get_post_comment post_id in
  let* date = Db.find Q.get_post_date post_id in
  let* image_info = Db.find_opt Q.get_post_image_info post_id in

  let* _tags = Db.fold Q.get_post_tags (fun tag acc -> tag :: acc) post_id [] in
  let* replies =
    Db.fold Q.get_post_replies (fun reply_id acc -> reply_id :: acc) post_id []
  in

  (* TODO special stuff for OP
     let* _subject = Db.find_opt Q.get_post_subject post_id in
     let* _latlng = Db.find_opt Q.get_post_gps post_id in
  *)
  let image_view =
    match image_info with
    | Some (_image_name, image_alt) ->
      (*TODO thumbnails *)
      (*TODO image info like file name and size on top of image*)
      Format.sprintf
        {|
    <div class="postImageContainer">
        <a href="/post_pic/%s" target="_blank">
        <img class="postImage" src="/post_pic/%s" alt="%s" title="%s" loading="lazy">
        </a>
    </div> 
|}
        post_id post_id image_alt image_alt
    | None -> ""
  in

  let pp_print_reply fmt reply =
    Format.fprintf fmt {|<a class="replyLink" href="#%s">&gt;&gt;%s</a>|} reply
      reply
  in
  let pp_print_replies =
    Format.asprintf {|<div class="replies">%a</div>|}
      (Format.pp_print_list ~pp_sep:Format.pp_print_space pp_print_reply)
  in

  let replies_view =
    match is_thread_preview with
    | None -> pp_print_replies replies
    | Some () -> (
      let res_nb = Db.find Q.count_thread_posts post_id in
      match res_nb with
      | Error _ -> ""
      | Ok ((1 | 2) as nb) ->
        Format.sprintf {|<div class="replies">%d reply</div>|} (nb - 1)
      | Ok nb ->
        Format.sprintf {|<div class="replies">%d replies</div>|} (nb - 1) )
  in

  let post_links_view =
    match is_thread_preview with
    | None ->
      Format.sprintf
        {|
        <span class=postNo>
            <a href="#%s" title="Link to this post">No.</a>
            <a href="javascript:insert_quote('%s')" "class=quoteLink title="Reply to this post">%s</a>
        </span>
        %s
        |}
        post_id post_id post_id replies_view
    | Some () -> Format.sprintf {|
        %s
        |} replies_view
  in

  let post_info_view =
    Format.sprintf
      {|
    <div class="postInfo">
        <span class="nick">%s</span>
        <span class="date" data-time="%d"></span>
        %s
    </div>|}
      nick date post_links_view
  in
  let post_view =
    Format.sprintf
      {|
<div class="container">
        <div class="post" id="%s">
            %s
            %s
            <blockquote class="postComment">%s</blockquote> 
        </div> 
</div> 
|}
      post_id post_info_view image_view comment
  in
  Ok post_view

let preview_thread thread_id = view_post ~is_thread_preview:() thread_id

let view_thread thread_id =
  let** _ = Db.find_opt Q.is_thread 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
    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
    | Some (Ok _) -> assert false
    | None ->
      let view_posts =
        List.map Result.get_ok (List.filter Result.is_ok view_posts)
      in
      let view_posts =
        Format.asprintf "%a"
          (Format.pp_print_list
             ~pp_sep:(fun fmt () -> Format.fprintf fmt "\r\n")
             Format.pp_print_string )
          view_posts
      in
      Ok view_posts )

let upload_post post =
  let post_id, parent_id, date, nick, comment, image, tags, citations, op_data =
    match post with
    | Op
        { id
        ; board
        ; date
        ; nick
        ; subject
        ; comment
        ; image
        ; tags
        ; longitude
        ; latitude
        ; replies = _replies
        ; citations
        } ->
      let op_data = Some (board, subject, longitude, latitude) in
      (id, id, date, nick, comment, Some image, tags, citations, op_data)
    | Reply
        { id
        ; parent_id
        ; date
        ; nick
        ; comment
        ; image
        ; tags
        ; replies = _replies
        ; citations
        } ->
      (id, parent_id, date, nick, comment, image, tags, citations, None)
  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 =
    match image with
    | None -> Ok ()
    | Some (image_name, image_content, alt) ->
      Db.exec Q.upload_post_image (post_id, image_name, image_content, alt)
  in
  let* _res_parent = Db.exec Q.upload_post_parent (post_id, parent_id) in
  let* _res_tags =
    match
      List.find_opt Result.is_error
        (List.map (fun tag -> Db.exec Q.upload_post_tag (post_id, tag)) tags)
    with
    | Some (Error e) -> Error e
    | Some _ -> assert false
    | None -> Ok ()
  in
  let* _res_citations =
    match
      List.find_opt Result.is_error
        (List.map
           (fun cited_id -> Db.exec Q.upload_post_reply (cited_id, post_id))
           citations )
    with
    | Some (Error e) -> Error e
    | Some _ -> assert false
    | None -> Ok ()
  in
  match op_data with
  | None -> Ok post_id
  | Some (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

let make_reply ~comment ?image ~tags ~parent_id nick =
  let comment = Dream.html_escape comment in
  let tags = Dream.html_escape tags in
  if Option.is_none (Uuidm.of_string parent_id) then
    Error "invalid thread id"
  else if String.length comment > 10000 then
    Error "invalid comment"
  else
    match parse_image image with
    | Error e -> Error e
    | Ok image ->
      if String.length tags > 1000 then
        Error "invalid tags"
      else
        (* TODO latlng validation? *)
        let tag_list = Str.split (Str.regexp " +") tags in
        let id = Uuidm.to_string (Uuidm.v4_gen random_state ()) in
        let date = int_of_float (Unix.time ()) in
        let comment, citations = parse_comment comment in
        let reply =
          Reply
            { id
            ; parent_id
            ; date
            ; nick
            ; comment
            ; image
            ; tags = tag_list
            ; replies = []
            ; citations
            }
        in
        upload_post reply

let make_op ~comment ~image ~tags ~subject ~lat ~lng ~board nick =
  let comment = Dream.html_escape comment in
  let tags = Dream.html_escape tags in
  let subject = Dream.html_escape subject in
  if String.length comment > 10000 then
    Error "invalid comment"
  else
    match parse_image (Some image) with
    | Error e -> Error e
    | Ok None -> assert false
    | Ok (Some image) ->
      if String.length tags > 1000 then
        Error "invalid tags"
      else
        (* TODO latlng validation? *)
        let is_valid_latlng = true in
        if not is_valid_latlng then
          Error "Invalid coordinate"
        else if String.length subject > 600 then
          Error "Invalid subject"
        else
          let tag_list = Str.split (Str.regexp " +") tags in
          let id = Uuidm.to_string (Uuidm.v4_gen random_state ()) in
          let date = int_of_float (Unix.time ()) in
          let comment, citations = parse_comment comment in
          let op =
            Op
              { id
              ; board
              ; date
              ; nick
              ; subject
              ; comment
              ; image
              ; tags = tag_list
              ; longitude = lng
              ; latitude = lat
              ; replies = []
              ; citations
              }
          in
          upload_post op

let get_markers board =
  let* thread_id_list =
    Db.fold Q.list_threads List.cons (int_of_board board) []
  in
  let markers_res =
    List.map
      (fun thread_id ->
        let** lat, lng = Db.find_opt Q.get_post_gps thread_id in
        match preview_thread thread_id with
        | Ok content -> Ok (lat, lng, content, thread_id)
        | Error e -> Error e )
      thread_id_list
  in
  let markers = List.map Result.get_ok (List.filter Result.is_ok markers_res) in

  let pp_marker fmt (lat, lng, content, thread_id) =
    Format.fprintf fmt
      {|{
  "type": "Feature",
  "geometry": {
    "type": "Point",
    "coordinates": [%s,%s]
  },
  "properties": {
    "content": "%s",
    "thread_id": "%s"
  }}|}
      (* geojson use lng lat, and not lat lng*)
      (Float.to_string lng)
      (Float.to_string lat) (String.escaped content) thread_id
  in
  let markers =
    Format.asprintf "[%a]"
      (Format.pp_print_list
         ~pp_sep:(fun fmt () -> Format.fprintf fmt ",")
         pp_marker )
      markers
  in
  Ok markers

let get_post_image post_id =
  let** content = Db.find_opt Q.get_post_image_content post_id in
  Ok content