add depends

src/client/html_post.ml

@@ -0,0 +1,335 @@
+open Brr
+open Note
+open Note_brr
+open Types
+open Client_types
+open Util
+
+let nick post =
+  El.a
+    ~at:
+      [ class' "user-link"
+      ; class' "post-author-nick"
+      ; mk_at "data-user-id" post.poster_id
+      ; Fmt.kstr href "/user/%s" post.poster_id
+      ]
+    [ el_txt post.poster_nick ]
+
+let date post =
+  let print_date t =
+    let t = Unix.localtime t in
+    Fmt.str "%02d-%02d-%02d %02d:%02d" (1900 + t.tm_year) (1 + t.tm_mon)
+      t.tm_mday t.tm_hour t.tm_min
+  in
+  El.span
+    ~at:[ class' "post-date"; mk_at "data-time" (string_of_float post.date) ]
+    [ el_txt (print_date post.date) ]
+
+(* TODO rm this since we can click the post_id? *)
+let link_to_post ?(is_vignette = false) post =
+  let url =
+    if is_vignette then Fmt.str "/thread/%d#%d" post.parent_t_id post.id
+    else Fmt.str "#%d" post.id
+  in
+  El.a
+    ~at:[ href url; title "Link to this post"; class' "post-link-to-self" ]
+    [ el_txt "#" ]
+
+let post_id post =
+  let el =
+    let at =
+      [ class' "post-id"
+      ; title "Reply to this post"
+      ; mk_at "data-id" (string_of_int post.id)
+      ; Fmt.kstr href "#%d" post.id
+      ]
+    in
+    El.a ~at [ el_txt (Fmt.str ">>%d" post.id) ]
+  in
+  hold_on el Ev.click (fun _ev ->
+      Events.send_action (Post_form_change Form_open);
+      Events.send_action (Post_form_change (Form_insert_quote post.id)) );
+  el
+
+let post_id_quote =
+  let is_local_link t_s id =
+    (* list of post currently on the page
+       (consider thread page case only) *)
+    let post_l =
+      match (S.value t_s).Model.page with
+      | Thread (Ready v) -> v.reply_l
+      | _ -> []
+    in
+    List.find_opt (fun p -> p.id = id) post_l |> Option.is_some
+  in
+  let hold_highlight_event el id =
+    let mouseenter = Evr.on_el Ev.mouseenter Evr.unit el in
+    let mouseleave = Evr.on_el Ev.mouseleave Evr.unit el in
+    let focus = Evr.on_el Ev.focus Evr.unit el in
+    let blur = Evr.on_el Ev.blur Evr.unit el in
+    let off = E.select [ mouseleave; blur ] |> E.map (fun () -> None) in
+    let on =
+      E.select [ mouseenter; focus ]
+      |> E.map (fun () -> Some (get_bounds el, id))
+    in
+    let event = E.select [ off; on ] in
+    hold_event_on el event (fun opt ->
+        Events.send_action (Quickview_change opt) );
+    ()
+  in
+  fun t_s id ->
+    let at = [ class' "post-id-quote"; mk_at "data-id" (string_of_int id) ] in
+    let txt = el_txt (Fmt.str ">>%d" id) in
+    match is_local_link t_s id with
+    | true ->
+      (* simple #%d link *)
+      let at = [ Fmt.kstr href "#%d" id ] @ at in
+      let el = El.a ~at [ txt ] in
+      hold_highlight_event el id;
+      el
+    | false ->
+      (* remote link *)
+      let at = [ class' "remote" ] @ at in
+      let container = El.span [] in
+      hold_highlight_event container id;
+      let children =
+        let open Page in
+        S.map (fun t -> t.Model.quickview) t_s
+        |> S.changes |> E.filter_map Fun.id
+        |> E.map (fun (rect, v) ->
+               let quickview_id = unwrap_post_id v in
+               fun last_value ->
+                 match quickview_id = id with
+                 | true -> Some (rect, v)
+                 | false -> last_value )
+        |> S.accum None
+        |> S.map (function
+             | None -> [ El.button ~at [ txt ] ]
+             | Some (_rect, v) -> (
+               match v with
+               | Loading _ ->
+                 let at = [ class' "loading" ] @ at in
+                 [ El.button ~at [ txt ] ]
+               | Not_found _ ->
+                 let at = [ class' "not-found" ] @ at in
+                 [ El.button ~at [ txt ] ]
+               | Ready p ->
+                 let at =
+                   [ class' "ready"
+                   ; Fmt.kstr href "/thread/%d#%d" p.parent_t_id p.id
+                   ]
+                   @ at
+                 in
+                 [ El.a ~at [ txt ] ] ) )
+      in
+      Elr.def_children container children;
+      container
+
+let post_menu t_s post =
+  let mk s =
+    El.a
+      ~at:
+        [ Fmt.kstr href "/%s/%d" s post.id
+        ; Fmt.kstr class' "%s-link" s
+        ; mk_at "data-post-id" (string_of_int post.id)
+        ]
+      [ el_txt (String.capitalize_ascii s) ]
+  in
+  let mk_content () =
+    let delete = mk "delete" in
+    let report = mk "report" in
+    let own_post =
+      S.map Model.get_user t_s
+      |> S.map (function
+           | None -> false
+           | Some u -> String.equal u.user_id post.poster_id )
+    in
+    def_on own_post delete;
+    [ delete; report ]
+  in
+  Html_util.mk_dropdown_menu ~class_prefix:"post-info" ~label:""
+    ~at_title:"Post menu" ~placeholder:false mk_content
+
+let backlinks t_s post =
+  let l = List.map (post_id_quote t_s) post.backlinks in
+  El.div ~at:[ class' "post-replies" ] l
+
+let image t_s ?(is_vignette = false) post =
+  match post.image_info with
+  | None -> None
+  | Some image -> (
+    (* TODO show image dimension/name *)
+    let mk is_small =
+      let class_small =
+        if is_small then [ class' "post-image-small" ] else []
+      in
+      let sizes =
+        [ mk_at "width"
+            (string_of_int (if is_small then image.thumb_w else image.w))
+        ; mk_at "height"
+            (string_of_int (if is_small then image.thumb_h else image.h))
+        ]
+      in
+      let url =
+        src
+        @@
+        if is_small then Fmt.str "/img/s/%d" post.id
+        else Fmt.str "/img/%d" post.id
+      in
+      let at =
+        class_small @ sizes
+        @ url
+          :: [ class' "post-image"
+             ; alt image.alt
+             ; title image.alt
+             ; mk_at "data-id" (string_of_int post.id)
+             ; mk_at "loading" "lazy"
+             ]
+      in
+      El.img ~at ()
+    in
+    let img_small, img_big = (mk true, mk false) in
+    let el = El.div ~at:[ class' "post-image-div" ] [ img_small ] in
+    match is_vignette with
+    | true -> Some el
+    | false ->
+      (* swap img_(small/big) on click *)
+      hold_on el Ev.click (fun _ev -> Events.send_action (Image_click post.id));
+      let img_s =
+        S.map (fun t -> t.Model.opened_image) t_s
+        |> S.map (function
+             | Some id when Int.equal id post.id -> [ img_big ]
+             | Some _ | None -> [ img_small ] )
+      in
+      Elr.def_children el img_s;
+      Some el )
+
+let comment =
+  let open Comment in
+  let insert_br_between_lines l =
+    match l with
+    | [] -> []
+    | hd :: tl ->
+      List.rev
+      @@ List.fold_left (fun acc x -> x :: [ El.br () ] :: acc) [ hd ] tl
+  in
+  let item t_s = function Txt s -> el_txt s | Id i -> post_id_quote t_s i in
+  let items t_s l = List.map (item t_s) l in
+  let line t_s = function
+    | Line l -> items t_s l
+    | Line_quote l ->
+      [ El.span ~at:[ class' "line-quote" ] (el_txt ">" :: items t_s l) ]
+  in
+  fun t_s comment ->
+    let content =
+      List.map (line t_s) comment |> insert_br_between_lines |> List.flatten
+    in
+    El.div ~at:[ class' "post-comment" ] content
+
+let info t_s post =
+  El.div
+    ~at:[ class' "post-info" ]
+    [ nick post
+    ; date post
+    ; post_id post
+    ; link_to_post post
+    ; post_menu t_s post
+    ; backlinks t_s post
+    ]
+
+let post_view t_s post =
+  let info = info t_s post in
+  let content =
+    let comment = comment t_s post.comment in
+    let l =
+      match image t_s post with
+      | None -> [ comment ]
+      | Some image -> [ image; comment ]
+    in
+    El.div ~at:[ class' "post-content" ] l
+  in
+  let at = [ class' "post"; id (string_of_int post.id) ] in
+  let el = El.div ~at [ info; content ] in
+  let is_selected =
+    S.map
+      (fun t ->
+        match t.Model.fragment with
+        | Id v ->
+          let id = Fragment.unwrap_id v in
+          post.id = id
+        | Empty | Top | Bottom -> false )
+      t_s
+  in
+  Elr.def_class (Jstr.v "selected") is_selected el;
+  let is_highlighted =
+    S.map (fun t -> t.Model.quickview) t_s
+    |> S.map (function
+         | None -> false
+         | Some (_rect, v) -> Int.equal post.id (Page.unwrap_post_id v) )
+  in
+  Elr.def_class (Jstr.v "highlighted") is_highlighted el;
+  el
+
+module Quickview = struct
+  open Model
+
+  let quickview_class = "quickview-div"
+
+  let to_px_jstr x = x |> int_of_float |> Fmt.str "%dpx" |> Jstr.of_string
+
+  let is_in_viewport post =
+    (* find highlighted post DOM element *)
+    let id = string_of_int post.id in
+    match find_html_el_by_id id with
+    | None -> false
+    | Some el ->
+      (* check bounds *)
+      let x, y, w, h = get_bounds el in
+      let ( <= ) x y = Float.compare x y <= 0 in
+      0. <= x && 0. <= y
+      && x +. w <= window_width ()
+      && y +. h <= window_height ()
+
+  let f t_s =
+    let container = El.div ~at:[ class' quickview_class ] [] in
+    let mk (id_x, id_y, id_w, id_h) post =
+      if is_in_viewport post then []
+      else
+        let quickview = post_view t_s post in
+        (* ensure we don't have duplicate html id attribute *)
+        El.set_at At.Name.id (Some (Jstr.v "quickview")) quickview;
+        (* hack: insert hidden quickview into DOM so we can compute it's bounds
+           we don't use the viewed post's already in DOM element for this
+             - it might actually not be in DOM
+             - it might have it's image opened and size changed *)
+        El.set_inline_style El.Style.visibility (Jstr.v "hidden") quickview;
+        El.set_children container [ quickview ];
+        (* compute quickview position *)
+        let quickview_x = id_x +. id_w in
+        let quickview_h = El.bound_h quickview in
+        let quickview_y = id_y +. (0.5 *. id_h) -. (0.5 *. quickview_h) in
+        let quickview_y =
+          clamp ~min:0. ~max:(window_height () -. quickview_h) quickview_y
+        in
+        (* undo quickview DOM insertion *)
+        El.set_inline_style El.Style.visibility (Jstr.v "visible") quickview;
+        El.remove quickview;
+        (* set quickview style *)
+        El.set_inline_style El.Style.position (Jstr.v "fixed") quickview;
+        El.set_inline_style El.Style.z_index (Jstr.v "99999") quickview;
+        El.set_inline_style El.Style.left (to_px_jstr quickview_x) quickview;
+        El.set_inline_style El.Style.top (to_px_jstr quickview_y) quickview;
+        [ quickview ]
+    in
+    let children =
+      S.map (fun t -> t.quickview) t_s
+      |> S.map (function
+           | None -> []
+           | Some (rect, v) -> (
+             match v with
+             | Page.Loading _ | Not_found _ -> []
+             | Ready post -> mk rect post ) )
+    in
+    Elr.def_children container children;
+    container
+end