geochan/src/client/html_form.ml

open Brr
open Note
open Note_brr
open Types
open Client_types
open Util

let handle_submit kind form ev =
  Fmt.pr "catched form submit event@.";
  Ev.prevent_default ev;
  Events.send_action (Submit_event (W kind, form));
  ()

let mk kind ~btn l =
  let class_prefix = Form_kind.name kind in
  let action = Form_kind.action kind in
  let at =
    [ Fmt.kstr class' "%s-form " class_prefix
    ; At.action (str action)
    ; At.method' (str "POST")
    ; mk_at "enctype" "multipart/form-data"
    ]
  in
  let content = l @ [ El.div [ btn ] ] in
  let form = El.form ~at content in
  hold_on form Brr_io.Form.Ev.submit (fun ev -> handle_submit kind form ev);
  form

(* -- TODO clean up this mess -- *)

let mk_field_unwraped kind ~name ~label ~at =
  let type' =
    type'
    @@
    match kind with
    | `Text | `Textarea _ -> "text"
    | `Password -> "password"
    | `File -> "file"
  in
  let label =
    El.label
      ~at:
        [ At.for' (str name); Fmt.kstr id "%s-label" name; class' "form-label" ]
      [ el_txt label ]
  in
  let at =
    [ type'
    ; id name
    ; At.name (str name)
    ; class' "form-label"
    ; Fmt.kstr (mk_at "aria-labelledby") "%s-label" name
    ]
    @ at
  in
  let item =
    match kind with
    | `Text | `File | `Password -> El.input ~at ()
    | `Textarea content -> El.textarea ~at [ el_txt content ]
  in
  (label, item)

let mk_field kind ~name ~label ~at =
  let label, item = mk_field_unwraped kind ~name ~label ~at in
  El.div [ label; item ]

let mk_btn ?(at = []) s =
  let at = [ type' "submit"; class' "submit-btn" ] @ at in
  El.button ~at [ el_txt s ]

let mk_btn_save () = mk_btn "Save"

let mk_btn_submit () = mk_btn "Submit"

let mk_logout () =
  let btn =
    let label = "❌ Logout" in
    let btn_class = "logount-btn" in
    El.button ~at:[ class' btn_class ] [ el_txt label ]
  in
  mk Logout ~btn []

let mk_box title l = El.div ~at:[ class' "form-box" ] (h2 title :: l)

let mk_register () =
  let nick = mk_field `Text ~name:"nick" ~label:"Nickname" ~at:[] in
  let email = mk_field `Text ~name:"email" ~label:"Email" ~at:[] in
  let password = mk_field `Password ~name:"password" ~label:"Password" ~at:[] in
  let btn = mk_btn_submit () in
  let el = mk Register ~btn [ nick; email; password ] in
  mk_box "Register" [ el ]

let mk_login () =
  let nick = mk_field `Text ~name:"login" ~label:"Nickname or email" ~at:[] in
  let password = mk_field `Password ~name:"password" ~label:"Password" ~at:[] in
  let btn = mk_btn_submit () in
  let el = mk Login ~btn [ nick; password ] in
  mk_box "Login" [ el ]

let mk_subject_field_unwraped () =
  mk_field_unwraped `Text ~name:"subject" ~label:"Subject" ~at:[]

let mk_comment_field_unwraped s =
  mk_field_unwraped (`Textarea s) ~name:"comment" ~label:"Comment" ~at:[]

let mk_image_field_unwraped () =
  let file_label, file =
    mk_field_unwraped `File ~name:"file" ~label:"Add picture"
      ~at:
        [ mk_at "accept"
            (String.concat "," (Array.to_list Config.supported_mime_type))
        ]
  in
  let alt =
    El.div
      ~at:[ class' "alt-image-input-div" ]
      [ mk_field (`Textarea "") ~name:"alt" ~label:"Image desciption" ~at:[] ]
  in
  ((file_label, file), alt)

let mk_image_field () =
  let (file_label, file), alt = mk_image_field_unwraped () in
  let file_div = El.div [ file_label; file ] in
  El.div ~at:[ class' "image-input-div" ] [ file_div; alt ]

(* -------- *)

let sync_field input ~on form_action =
  hold_on input Ev.input (fun _ev ->
      let s = El.prop El.Prop.value input |> Jstr.to_string in
      Events.send_action (Post_form_change (form_action s)) );
  Elr.set_prop El.Prop.value ~on input;
  ()

let mk_comment_div t_s =
  let open Model in
  let label, textarea = mk_comment_field_unwraped "" in
  let () =
    let on = S.map (fun t -> t.post_form.comment |> Jstr.v) t_s |> S.changes in
    let send s = Client_types.Form_comment s in
    sync_field textarea ~on send
  in
  let focus_e =
    S.map
      (fun t ->
        (* take reply_form here and not reply_form.is_open
             so focus turn on when textarea content changes (quote insertion) *)
        t.post_form )
      t_s
    |> S.changes
    |> E.filter_map (fun rf ->
           match rf.Post_form_data.is_open with
           | false -> None
           | true -> Some true )
  in
  Elr.set_has_focus ~on:focus_e textarea;
  El.div ~at:[ class' "comment-input-div" ] [ label; textarea ]

let mk_image_div t_s =
  let open Model in
  let (file_label, file), alt = mk_image_field_unwraped () in
  let () =
    let has_file = S.map (fun t -> Option.is_some t.post_form.file) t_s in
    Util.def_visibility `On has_file alt;
    let on =
      S.map (fun t -> t.post_form.alt) t_s
      |> S.changes |> E.filter_map Fun.id |> E.map Jstr.v
    in
    let send s =
      let opt = if String.equal s "" then None else Some s in
      Client_types.Form_alt opt
    in
    sync_field alt ~on send
  in
  hold_on file Ev.change (fun _ev ->
      let opt =
        match El.Input.files file with
        | [] -> None
        | file :: _l ->
          let s = File.name file |> Jstr.to_string in
          Some s
      in
      Events.send_action (Post_form_change (Form_file opt)) );
  (* clear image file name if needed *)
  let on =
    S.map
      (fun t ->
        match t.post_form.file with
        | None -> Some (Jv.to_jstr Jv.null)
        | Some _s -> None )
      t_s
    |> S.changes |> E.filter_map Fun.id
  in
  Elr.set_prop El.Prop.value ~on file;
  let file_div = El.div [ file_label; file ] in
  El.div ~at:[ class' "image-input-div" ] [ file_div; alt ]

let new_thread_el t_s =
  let open Model in
  let subject =
    let label, input = mk_subject_field_unwraped () in
    let () =
      let on =
        S.map (fun t -> t.post_form.subject |> Jstr.v) t_s |> S.changes
      in
      let send s = Client_types.Form_subject s in
      sync_field input ~on send
    in
    El.div ~at:[ class' "subject-input-div" ] [ label; input ]
  in
  let comment = mk_comment_div t_s in
  let image = mk_image_div t_s in
  let lat =
    El.input ~at:[ type' "hidden"; id "lat-input"; name "lat-input" ] ()
  in
  let lng =
    El.input ~at:[ type' "hidden"; id "lng-input"; name "lng-input" ] ()
  in
  let latlng_s = S.map (fun t -> t.post_form.latlng) t_s in
  Elr.def_at At.Name.value
    (latlng_s |> S.map (Option.map fst) |> S.map (Option.map Jstr.of_float))
    lat;
  Elr.def_at At.Name.value
    (latlng_s |> S.map (Option.map snd) |> S.map (Option.map Jstr.of_float))
    lng;
  let btn =
    let at = [ class' "submit-post-btn" ] in
    mk_btn ~at "Post"
  in
  Util.def_disabled (S.map Option.is_none latlng_s) btn;
  mk Home ~btn [ subject; comment; image; lat; lng ]

let profile user =
  let mk ~btn l = mk Profile ~btn l in
  let nickname =
    let nick =
      mk_field `Text ~name:"nick" ~label:"Change nickname"
        ~at:[ value user.user_nick ]
    in
    let btn = mk_btn_save () in
    let form = mk ~btn [ nick ] in
    mk_box "Nickname" [ form ]
  in
  let bio =
    let bio =
      mk_field (`Textarea user.bio) ~name:"bio" ~label:"Change your biography"
        ~at:[]
    in
    let btn = mk_btn_save () in
    let form = mk ~btn [ bio ] in
    mk_box "Biography" [ form ]
  in
  let avatar =
    (* TODO
       - small preview off current avatar on the left of delete avatar button
       - preview of image to be uploaded
       - add image preview in new-thread/reply form too*)
    let delete =
      user.avatar_info
      |> Option.map (fun _ ->
             let input_el =
               El.input
                 ~at:[ type' "hidden"; name "delete-avatar"; value "" ]
                 ()
             in
             let btn = mk_btn "delete current avatar" in
             mk ~btn [ input_el ] )
      |> Option.to_list
    in
    let upload =
      let file_el =
        mk_field `File ~name:"file" ~label:"Change your avatar"
          ~at:
            [ mk_at "accept"
                (String.concat "," (Array.to_list Config.supported_mime_type))
            ]
      in
      (* TODO disable alt field if no image; do the same for post form *)
      let alt_el =
        let content =
          Option.fold ~none:"" ~some:(fun img -> img.alt) user.avatar_info
        in
        mk_field (`Textarea content) ~name:"alt" ~label:"Image desciption"
          ~at:[]
      in
      let btn = mk_btn_save () in
      [ mk ~btn [ file_el; alt_el ] ]
    in
    mk_box "Avatar" (delete @ upload)
  in
  [ nickname; bio; avatar ]

let account user_private =
  let mk ~btn l = mk Account ~btn l in
  let email =
    let email =
      mk_field `Text ~name:"email" ~label:"Email"
        ~at:[ value user_private.User_private.email ]
    in
    let btn = mk_btn_save () in
    let form = mk ~btn [ email ] in
    mk_box "Change email" [ form ]
  in
  let password =
    let pw1 =
      mk_field `Password ~name:"new-password" ~label:"New password" ~at:[]
    in
    let pw2 =
      mk_field `Password ~name:"confirm-new-password"
        ~label:"Confirm new password" ~at:[]
    in
    let btn = mk_btn_save () in
    let form = mk ~btn [ pw1; pw2 ] in
    mk_box "Change password" [ form ]
  in
  let big_delete =
    let btn = mk_btn ~at:[ class' "delete-account-btn" ] "DELETE ACCOUNT" in
    let form =
      mk ~btn
        [ El.input ~at:[ type' "hidden"; name "delete-account"; value "" ] () ]
    in
    mk_box "Delete account" [ form ]
  in
  [ email; password; big_delete ]

let delete post =
  let btn = mk_btn "DELETE" in
  mk (Delete post.id) ~btn []

let report post =
  let btn = mk_btn "Report" in
  let reason = mk_field `Text ~name:"reason" ~label:"Reason" ~at:[] in
  mk (Report post.id) ~btn [ reason ]

let admin_ignore post_id =
  let btn = mk_btn "ignore" in
  mk (Admin_ignore post_id) ~btn []

let admin_delete post_id =
  let btn = mk_btn "DELETE" in
  mk (Admin_delete post_id) ~btn []

let admin_banish user_id =
  let btn = mk_btn "BANISH" in
  mk (Admin_banish user_id) ~btn []

module Dragzone = struct
  (* TODO
     - send drag_state to model on dragend (mouseup)
       need to differentiate which popup we are dragging for this *)
  let drag_state = ref None

  let on_mousedown dragzone container ev =
    match !drag_state with
    | Some _ -> Fmt.failwith "Dragzone state error: double mousedown?"
    | None ->
      let evt = Ev.as_type ev in
      let offset_x = El.bound_x container -. Ev.Mouse.client_x evt in
      let offset_y = El.bound_y container -. Ev.Mouse.client_y evt in
      drag_state := Some (dragzone, container, offset_x, offset_y);
      (* css so nothing get highlighted *)
      El.set_inline_style (Jstr.v "user-select") (Jstr.v "none") body;
      El.set_inline_style (Jstr.v "pointer-events") (Jstr.v "none") body;
      El.set_inline_style (Jstr.v "pointer-events") (Jstr.v "auto") dragzone

  let on_mousemove ev =
    match !drag_state with
    | None -> ()
    | Some (_dragzone, container, offset_x, offset_y) ->
      let evt = Ev.as_type ev in
      let x = Ev.Mouse.client_x evt +. offset_x in
      let y = Ev.Mouse.client_y evt +. offset_y in
      let x = clamp ~min:0. ~max:(window_width () -. El.bound_w container) x in
      let y = clamp ~min:0. ~max:(window_height () -. El.bound_h container) y in
      El.set_inline_style El.Style.position (Jstr.v "fixed") container;
      El.set_inline_style El.Style.left (Fmt.kstr Jstr.v "%fpx" x) container;
      El.set_inline_style El.Style.top (Fmt.kstr Jstr.v "%fpx" y) container

  let on_mouseup _ev =
    match !drag_state with
    | None -> ()
    | Some (dragzone, _container, _, _) ->
      El.set_inline_style (Jstr.v "user-select") (Jstr.v "") body;
      El.set_inline_style (Jstr.v "pointer-events") (Jstr.v "") body;
      El.set_inline_style (Jstr.v "pointer-events") (Jstr.v "") dragzone;
      drag_state := None

  let () =
    hold_endless_on_window Ev.mousemove on_mousemove;
    hold_endless_on_window Ev.mouseup on_mouseup;
    ()

  let f ~dragzone container =
    hold_on dragzone Ev.mousedown (fun ev -> on_mousedown dragzone container ev);
    ()
end