geochan/src/discuss.ml

open Syntax

(** Creating the table of all messages.

    Each message is made of :

    - an id (msg_id)
    - the id of the sender (from_id)
    - the id of the receiver (to_id)
    - some text (msg)

    TODO: add date ? *)

module Q = struct
  open Caqti_request.Infix
  open Caqti_type

  let create_msg_table =
    Db.exec
    @@ (unit ->. unit)
         "CREATE TABLE IF NOT EXISTS msg ( msg_id TEXT, from_id TEXT, to_id \
          TEXT, msg TEXT, PRIMARY KEY(msg_id), FOREIGN KEY(from_id) REFERENCES \
          user(user_id) ON DELETE CASCADE, FOREIGN KEY(to_id) REFERENCES \
          user(user_id) ON DELETE CASCADE)"

  let find_comrades =
    Db.collect_list
    @@ (tup2 string string ->* tup2 string string)
         "SELECT from_id, to_id FROM msg WHERE from_id=? OR to_id=?"

  let find_messages =
    Db.collect_list
    @@ (tup2 (tup2 string string) (tup2 string string) ->* tup2 string string)
         "SELECT from_id, msg FROM msg WHERE (from_id=? AND to_id=?) OR \
          (from_id=? AND to_id=?)"

  let insert_msg =
    Db.exec
    @@ (tup3 string string string ->. unit)
         "INSERT INTO msg VALUES (NULL, ?, ?, ?)"
end

let () =
  Result.iter_error
    (fun _e -> Dream.error (fun log -> log "can't create table"))
    (Q.create_msg_table ())

(** let's find who the user is talking to so we can know if they're dangerous *)
let find_comrades user_id =
  let* comrades = Q.find_comrades (user_id, user_id) in
  let comrades =
    List.map (fun (l, r) -> if l = user_id then r else l) comrades
  in
  Ok (List.sort_uniq String.compare comrades)

(** find all messages between two товарищи *)
let find_messages k1 k2 = Q.find_messages ((k1, k2), (k2, k1))

(** display the list of discussions *)
let render =
  let pp_one_discuss fmt (id, nick) =
    Format.fprintf fmt {|<li><a href="/discuss/%s">%s</a></li>|} id nick
  in
  fun request ->
    Utils.logged_in_or_redirect request (fun user_id ->
        Utils.render_result request
        @@ let* comrades = find_comrades user_id in
           let* comrades =
             Syntax.unwrap_list
               (fun id ->
                 match User.get_nick id with
                 | Error _e as e -> e
                 | Ok nick -> Ok (id, nick) )
               comrades
           in
           Ok
             (Format.asprintf "<ul>%a</ul>"
                (Format.pp_print_list
                   ~pp_sep:(fun fmt () -> Format.fprintf fmt "<br />")
                   pp_one_discuss )
                comrades ) )

let pp_discussion (request, user_id, comrade_id) =
  let path = Format.sprintf "/discuss/%s" comrade_id in
  Utils.render_result request
  @@ let* msg = find_messages user_id comrade_id in
     let* user_nick = User.get_nick user_id in
     let* comrade_nick = User.get_nick comrade_id in
     let pp_one_msg fmt (from_id, msg) =
       Format.fprintf fmt "<li>%s | %s</li>"
         (if from_id = user_id then user_nick else comrade_nick)
         (Dream.html_escape msg)
     in
     let pp_all_msg fmt msg =
       Format.fprintf fmt "<ul>%a</ul>"
         (Format.pp_print_list
            ~pp_sep:(fun fmt () -> Format.fprintf fmt "<br />")
            pp_one_msg )
         msg
     in
     Ok
       (Format.asprintf
          {|%a<br />
          %s
          <input value="" name="msg" type="text" />
          <button type="submit" class="btn btn-primary">Send</button>
        </form>|}
          pp_all_msg msg
          (Dream.form_tag ~action:path request) )

(** display one discussion *)
let renderone request =
  Utils.logged_in_or_redirect request (fun user_id ->
      let comrade_id = Dream.param request "comrade_id" in
      pp_discussion (request, user_id, comrade_id) )

let insert_msg from_id to_id msg = Q.insert_msg (from_id, to_id, msg)

(** handle posts *)
let post request =
  Utils.logged_in_or_redirect request (fun user_id ->
      match%lwt Dream.form request with
      | `Ok [ ("msg", msg) ] -> begin
        let comrade_id = Dream.param request "comrade_id" in
        match insert_msg user_id comrade_id msg with
        | Ok () -> pp_discussion (request, user_id, comrade_id)
        | Error e -> Utils.render e request
      end
      | form -> Utils.handle_invalid_form form )