geochan/src/client/html.ml

open Brr
open Note
open Note_brr
open Types
open Client_types
open Page
open Model
open Util
open Html_util

module Header = struct
  let mk t_s =
    let left = El.div ~at:[ class' "nav-left" ] [ mk_page_link Home ] in
    let right session =
      let dropmenu user =
        let class_prefix = "settings" in
        let label = user.user_nick in
        let at_title = "Settings" in
        let mk_content () =
          [ mk_page_link Profile
          ; mk_page_link Account
          ; Html_form.mk_logout ()
          ; mk_page_link About
          ]
        in
        mk_dropdown_menu ~class_prefix ~label ~at_title ~placeholder:true
          mk_content
      in
      let l =
        match Option.map user_private_to_public session.user_private with
        | None -> List.map mk_page_link [ About; Register; Login ]
        | Some u when u.user_is_admin ->
          [ mk_page_link (Admin (Loading ())); dropmenu u ]
        | Some u -> [ dropmenu u ]
      in
      El.div ~at:[ class' "nav-right" ] l
    in
    let children = S.map (fun t -> [ left; right t.session ]) t_s in
    let el = El.nav [] in
    Elr.def_children el children;
    el

  let f t_s =
    let header = El.header [ mk t_s ] in
    header
end

module Home = struct
  let left t_s =
    let new_thread_view =
      (* TODO try to find better class names *)
      El.div
        ~at:[ class' "new-thread-view" ]
        [ El.div
            ~at:[ class' "form-box" ]
            [ h2 "New thread"
            ; El.span
                ~at:[ class' "new-thread-info" ]
                [ el_txt "Click the map and make a new thread:" ]
            ; El.div
                ~at:[ class' "new-thread-form-div" ]
                [ Html_form.new_thread_el t_s ]
            ]
        ]
    in
    let thread_view = Html_thread.f t_s in
    let return_link = El.a ~at:[ href (to_path Home) ] [ el_txt "Return" ] in
    def_visibility_when_page [ New_thread ] `On new_thread_view t_s;
    def_visibility_when_page [ Thread ] `On thread_view t_s;
    def_visibility_when_page [ New_thread ] `On return_link t_s;
    let el =
      El.div ~at:[ class' "home-left" ] [ new_thread_view; thread_view ]
    in
    el

  let f t_s =
    let left_el = left t_s in
    let right_el = Leaflet_map.f t_s in
    let el = El.div ~at:[ class' "home-page" ] [ left_el; right_el ] in
    def_visibility_when_page [ Home; New_thread; Thread ] `On el t_s;
    el
end

module About = struct
  let f t_s =
    let l = [ h1 "TODO about page" ] in
    let el = mk_page About t_s l in
    el
end

module Register = struct
  let f t_s =
    let l = [ Html_form.mk_register () ] in
    let el = mk_page Register t_s l in
    el
end

module Login = struct
  let f t_s =
    let l = [ Html_form.mk_login () ] in
    let el = mk_page Login t_s l in
    el
end

module Admin = struct
  let mk t_s t =
    match get_user_admin t with
    | None -> []
    | Some _user -> (
      match t.page with
      | Home | New_thread | Thread _ | About | Register | Login | Profile
      | Account | Delete _ | Report _ | User _ ->
        []
      | Admin (Loading ()) -> loading_el
      | Admin (Not_found ()) -> not_found_el
      | Admin (Ready reports) ->
        let forms =
          match reports with
          | [] ->
            [ el_txt "Report list is empty!~"
            ; El.br ()
            ; el_txt "good job! ( ๑>ᴗ<๑ )"
            ]
          | reports ->
            (* TODO add reported_post_parent_t_id to report type? *)
            List.map
              (fun report ->
                let post = report.reported_post in
                let post_view = Html_post.post_view t_s post in
                let span_info_on_report =
                  let s =
                    Fmt.str "From: %s, Reason: %s" report.reporter_nick
                      report.reason
                  in
                  El.span [ el_txt s ]
                in
                let forms =
                  El.div
                    Html_form.
                      [ admin_ignore post.id
                      ; admin_delete post.id
                      ; admin_banish post.poster_id
                      ]
                in
                El.div
                  ~at:[ class' "report" ]
                  [ post_view; span_info_on_report; forms ] )
              reports
        in
        let reports_div = El.div ~at:[ class' "reports-div" ] forms in
        [ h1 "Administration board"; reports_div ] )

  let f t_s =
    let el = mk_page Admin t_s [] in
    Elr.def_children el (S.map (mk t_s) t_s);
    el
end

module Profile = struct
  let mk t =
    match get_user t with
    | None -> []
    | Some user ->
      let public_profile_link =
        El.p
          [ el_txt "Check your "
          ; mk_page_link ~label:"public profile" (User (Loading user.user_id))
          ]
      in
      let forms =
        El.div ~at:[ class' "form-box-list" ] (Html_form.profile user)
      in
      [ h1 "Profile settings"; public_profile_link; forms ]

  let f t_s =
    let el = mk_page Profile t_s [] in
    Elr.def_children el (S.map mk t_s);
    el
end

module Account = struct
  let mk t =
    match get_user_private t with
    | None -> []
    | Some user_private ->
      let forms =
        El.div ~at:[ class' "form-box-list" ] (Html_form.account user_private)
      in
      [ h1 "Account settings"; forms ]

  let f t_s =
    let el = mk_page Account t_s [] in
    Elr.def_children el (S.map mk t_s);
    el
end

module User = struct
  let mk t =
    match t.page with
    | Home | New_thread | Thread _ | About | Register | Login | Admin _
    | Profile | Account | Delete _ | Report _ ->
      []
    | User (Loading _user_id) -> loading_el
    | User (Not_found _user_id) -> not_found_el
    | User (Ready user) ->
      let bio = El.div [ El.blockquote (Html_util.insert_br user.bio) ] in
      let img =
        match user.avatar_info with
        | None -> []
        | Some info ->
          let alt_at =
            if String.equal "" info.alt then []
            else [ alt info.alt; name info.name; title info.alt ]
          in
          let at =
            [ Fmt.kstr src "/user/%s/avatar" user.user_id
            ; class' "img-thumbnail"
            ]
            @ alt_at
          in
          [ El.img ~at () ]
      in
      h1 user.user_nick :: bio :: img

  let f t_s =
    let el = mk_page User t_s [] in
    Elr.def_children el (S.map mk t_s);
    el
end

module Delete = struct
  let mk t_s t =
    match get_user t with
    | None -> []
    | Some user -> (
      match t.page with
      | Home | New_thread | Thread _ | About | Register | Login | Admin _
      | Profile | Account | Report _ | User _ ->
        []
      | Delete (Loading _id) -> loading_el
      | Delete (Not_found _id) -> not_found_el
      | Delete (Ready post) -> (
        match String.equal post.poster_id user.user_id with
        | false -> (* TODO error can not delete other's posts *) []
        | true ->
          let post_view = Html_post.post_view t_s post in
          let form = Html_form.delete post in
          [ post_view; form ] ) )

  let f t_s =
    let el = mk_page Delete t_s [] in
    Elr.def_children el (S.map (mk t_s) t_s);
    el
end

module Report = struct
  let mk t_s t =
    match get_user t with
    | None -> []
    | Some _user -> (
      match t.page with
      | Home | New_thread | Thread _ | About | Register | Login | Admin _
      | Profile | Account | Delete _ | User _ ->
        []
      | Report (Loading _id) -> loading_el
      | Report (Not_found _id) -> not_found_el
      | Report (Ready post) ->
        let post_view = Html_post.post_view t_s post in
        let form = Html_form.report post in
        [ post_view; form ] )

  let f t_s =
    let el = mk_page Report t_s [] in
    Elr.def_children el (S.map (mk t_s) t_s);
    el
end

module Error_popup = struct
  let mk container_el opt =
    match opt with
    | None -> []
    | Some error ->
      let dragzone =
        let close_btn =
          El.button ~at:[ class' "close-error-popup-btn" ] [ el_txt "X" ]
        in
        hold_on close_btn Ev.click (fun _ev -> Events.send_action Clear_error);
        El.div ~at:[ class' "error-popup-dragzone" ] [ close_btn ]
      in
      Html_form.Dragzone.f ~dragzone container_el;
      let content =
        El.div
          ~at:[ class' "error-popup-content" ]
          [ El.span [ el_txt (Fmt.str "%a" Client_types.pp_error error) ] ]
      in
      [ dragzone; content ]

  let f t_s =
    let el = El.div ~at:[ class' "error-popup" ] [] in
    Elr.def_children el (S.map (fun t -> mk el t.error) t_s);
    let is_error = S.map (fun t -> Option.is_some t.error) t_s in
    def_visibility `On is_error el;
    el
end

module Image_overlay = struct
  let mk opt =
    match opt with
    | None -> []
    | Some img ->
      let el = mk_image ~is_small:false img in
      [ el ]

  let f t_s =
    let el = El.div ~at:[ class' "image-overlay" ] [] in
    def_visibility `On (S.map (fun t -> Option.is_some t.opened_image) t_s) el;
    Elr.def_children el (S.map (fun t -> mk t.opened_image) t_s);
    (* on overlay click (that should cover whole screen) send action to close overlay *)
    hold_on el Ev.click (fun _ev -> Events.send_action (Image_change None));
    el
end

module Main = struct
  let f t_s =
    let l =
      List.map
        (fun f -> f t_s)
        [ Home.f
        ; About.f
        ; Register.f
        ; Login.f
        ; Admin.f
        ; Profile.f
        ; Account.f
        ; User.f
        ; Delete.f
        ; Report.f
        ; Error_popup.f
        ; Image_overlay.f
        ]
    in
    let main = El.v (str "main") l in
    main
end

let def_page_title t_s =
  let set_title page =
    let s =
      match page with
      | Thread (Loading _) | User (Loading _) -> "loading"
      | Thread (Not_found _) | User (Not_found _) -> "not found"
      | Thread (Ready v) -> v.subject
      | User (Ready u) -> u.user_nick
      | page -> (
        match to_kind page with
        | New_thread -> "new thread"
        | kind -> Kind.to_string kind )
    in
    Fmt.str "%s | Geochan" s |> String.capitalize_ascii |> Jstr.v
    |> Document.set_title G.document
  in
  S.map (fun t -> t.page) t_s |> S.changes |> hold_endless set_title;
  (* init *)
  let k = (S.value t_s).page in
  set_title k;
  ()

let f t_s =
  let header_el = Header.f t_s in
  let main_el = Main.f t_s in
  def_page_title t_s;
  [ header_el; main_el ]