geochan/src/client/model.ml

open Types
open Client_types
open Page

type t =
  { (* navigation state *)
    session : session
  ; fragment : Fragment.t
  ; (* ui state *)
    catalog : thread list
  ; page : Page.t
  ; post_form : Post_form_data.t
  ; map_view : float * float * int
  ; (* todo: just remove rect from here *)
    quickview : (rect * (post_id, post) wrap) option
  ; opened_image : Img_info.t option
  ; error : Client_types.error option
  }

(* TODO better session initialization/no dummy *)
(* initialize session with dummy data and launch a GET.session request
   catalog will be fetched on home and thread page navigation *)
let init () =
  Fmt.pr "model init@.";
  let dummy_session =
    { user_private = None; csrf_token = "dummy"; csrf_time_limit = 0.0 }
  in
  Network.GET.session ();
  { session = dummy_session
  ; fragment = Empty
  ; catalog = Db.get_catalog ()
  ; page = Home
  ; post_form = Post_form_data.empty
  ; map_view = Storage.init_map_view ()
  ; quickview = None
  ; opened_image = None
  ; error = None
  }

(* TODO mv to ../util.ml *)
let user_private_to_public u =
  let User_private.
        { user_id; user_nick; user_is_admin; bio; avatar_info; email = _ } =
    u
  in
  { user_id; user_nick; user_is_admin; bio; avatar_info }

let get_user t = Option.map user_private_to_public t.session.user_private

let get_user_private t = t.session.user_private

let get_user_admin t =
  match get_user t with
  | None -> None
  | Some u -> ( match u.user_is_admin with false -> None | true -> Some u )

let get_thread_w_reply t = match t.page with Thread t -> Some t | _ -> None

(* TODO
   - use CSS `scroll-margin-top` property *)
(* History.push_state does not fire hashchange + scroll, so we have to do it
   manually this relies on html `id` attribute:
   - id attribute must exists and be unique
     be careful to have posts only once in the html
   - if html is invalid and multiple element have the same id.
       it scroll to the first, which can be in a hidden page
   This must be called after a fragment change when page is ready.
   The DOM need to be re-rendered before we scroll_into_view.
   So the scoll is delayed to the next JavaScript event loop cycle
   with [Futr.to_event] *)
let schedule_scroll_into_view =
  let f opt =
    match opt with
    | None -> ()
    | Some "" -> ()
    | Some id -> (
      match Util.find_html_el_by_id id with
      | None ->
        Fmt.failwith "scroll_into_view: html element with id `%s` not found@."
          id
      | Some el ->
        Fmt.pr "scroll_into_view `%s`@." id;
        Brr.El.scroll_into_view el )
  in
  fun s ->
    let open Note in
    (* TODO hold; need a hold_once? *)
    let _ : Logr.t =
      Fut.return s |> Note_brr.Futr.to_event |> E.obs
      |> Logr.(app (const f))
      |> Logr.create ~now:false
    in
    ()

let load_aux find is_404 id =
  match find id with
  | Some v -> Ready v
  | None -> (
    match is_404 id with true -> Not_found id | false -> Loading id )

let load_thread v =
  let id = unwrap_thread_id v in
  load_aux Db.find_thread_w_reply Db.thread_is_404 id

let load_post v =
  let id = unwrap_post_id v in
  load_aux Db.find_post Db.post_is_404 id

let load_user v =
  let id = unwrap_user_id v in
  load_aux Db.find_user Db.user_is_404 id

let load_fragment page fragment =
  let open Fragment in
  match fragment with
  | Empty | Top | Bottom -> fragment
  | Id v ->
    let id = unwrap_id v in
    (* only consider fragment on thread pages *)
    let v =
      match page with
      | Thread v -> (
        match v with
        | Loading _ -> Loading id
        | Not_found _ -> Not_found id
        | Ready v -> (
          match List.exists (fun p -> p.id = id) v.reply_l with
          | false -> Not_found id
          | true -> Ready id ) )
      | _ -> Not_found id
    in
    Id v

let load_page = function
  | Home -> Home
  | New_thread -> New_thread
  | About -> About
  | Register -> Register
  | Login -> Login
  | Profile -> Profile
  | Account -> Account
  | Admin _ -> Admin (Ready (Db.get_reports ()))
  | Thread id -> Thread (load_thread id)
  | User id -> User (load_user id)
  | Delete id -> Delete (load_post id)
  | Report id -> Report (load_post id)

let load_quickview opt =
  opt
  |> Option.map (fun (rect, v) ->
         ( rect
         , match v with Ready _ | Not_found _ -> v | Loading _ -> load_post v ) )

let load_model t =
  let session = Db.get_session () in
  let catalog = Db.get_catalog () in
  let page = load_page t.page in
  let fragment = load_fragment page t.fragment in
  let () =
    match
      (Fragment.get_ready_value t.fragment, Fragment.get_ready_value fragment)
    with
    | _, None | Some _, Some _ -> ()
    | None, Some s -> schedule_scroll_into_view s
  in
  let quickview = load_quickview t.quickview in
  { t with session; catalog; page; fragment; quickview }

let do_post_form_action form_action post_form =
  let open Post_form_data in
  match form_action with
  | Form_open -> { post_form with is_open = true }
  | Form_close -> { post_form with is_open = false }
  | Form_insert_quote id ->
    let comment =
      let s = post_form.comment in
      (* insert quote on newline *)
      match String.ends_with ~suffix:"\n" s || String.length s = 0 with
      | true -> Fmt.str "%s>>%d " s id
      | false -> Fmt.str "%s@\n>>%d " s id
    in
    { post_form with comment }
  | Form_comment comment -> { post_form with comment }
  | Form_file file -> { post_form with file }
  | Form_alt alt -> { post_form with alt }
  | Form_subject subject -> { post_form with subject }
  | Form_latlng latlng -> { post_form with latlng }
  | Form_reset -> Post_form_data.empty

let do_map_action a t =
  let set_latlng t opt =
    let post_form = do_post_form_action (Form_latlng opt) t.post_form in
    { t with post_form }
  in
  match a with
  | Move_end map_view | Zoom_end map_view ->
    Storage.set_map_view map_view;
    { t with map_view }
  | Geoloc_start -> t
  | Geoloc_pos (_pos : Brr_io.Geolocation.Pos.t) -> t
  | Geoloc_err (_err : Brr_io.Geolocation.Error.t) -> t
  | Click_latlng latlng -> (
    match t.page with New_thread -> set_latlng t (Some latlng) | _ -> t )
  | Click_marker _thread_id -> set_latlng t None

let do_action : Client_types.action -> t -> t =
 fun action t ->
  Fmt.pr {|do action: "%a"@.|} pp_action action;
  match action with
  | Navigation_event (page_opt, frag) ->
    let page =
      match page_opt with
      | None -> t.page
      | Some loading_page ->
        Network.GET.f loading_page;
        load_page loading_page
    in
    let fragment = load_fragment page frag in
    let () =
      match Fragment.get_ready_value fragment with
      | None -> ()
      | Some s -> schedule_scroll_into_view s
    in
    (* when we click the id to go to post blur event is not triggered,
       so we clear quick view on hashchange too *)
    let quickview = None in
    let post_form =
      match page_opt with
      | None -> t.post_form
      | Some _ -> { t.post_form with is_open = false; latlng = None }
    in
    { t with page; fragment; quickview; post_form }
  | Post_form_change form_action -> (
    (* TODO error message/feedback; use Validate_str *)
    (* ignore reply form action if not logged in *)
    match get_user t with
    | None -> t
    | Some _ ->
      let post_form = do_post_form_action form_action t.post_form in
      { t with post_form } )
  | Map_input map_action -> do_map_action map_action t
  | Submit_event (Form_kind.W kind, form) ->
    let session = Db.get_session () in
    Network.POST.f kind form session.csrf_token;
    let t =
      match kind with
      | Logout ->
        (* todo reload window? Brr.Window.reload Brr.G.window; *)
        (* clear all state on logout
           we do it here so we can logout even if offline *)
        Db.clear ();
        Storage.clear ();
        init ()
      | _ -> t
    in
    t
  | Quickview_change opt ->
    let quickview =
      opt |> Option.map (fun (rect, v) -> (rect, Loading v)) |> load_quickview
    in
    begin
      match quickview with
      | Some (_, Loading post_id) -> Network.GET.post post_id
      | _ -> ()
    end;
    { t with quickview }
  | Image_change opened_image -> { t with opened_image }
  | Clear_error -> { t with error = None }

let do_data_update : Client_types.data_update -> t -> t =
 fun action t ->
  Fmt.pr {|do data update: "%a"@.|} pp_data_update action;
  begin
    match action with
    | Post_update v -> Db.add_post v
    | Thread_update thread_w_reply ->
      Db.update_thread_w_reply (Some thread_w_reply)
    | Catalog_update l -> Db.update_catalog l
    | User_update u -> Db.update_user (Some u)
    | Reports_update reports -> Db.update_reports reports
    | Session_update session -> Db.update_session session
  end;
  load_model t

let do_error : Client_types.error -> t -> t =
 fun e t ->
  Fmt.pr {|do error: "%a"@.|} pp_error e;
  let t = { t with error = Some e } in
  let () =
    match e with
    | Network_err _ -> ()
    | Err_response e -> (
      match e with
      | Not_found_post id -> Db.add_post_404 id
      | Not_found_thread id -> Db.add_thread_404 id
      | Not_found_user user_id -> Db.add_user_404 user_id
      | _ -> () )
  in
  load_model t