def_visibility + reactive map buttons

src/client/html.ml

@@ -64,19 +64,19 @@ module Home = struct
         ]
     in
     let thread_view = Html_thread.f t_s in
-    let new_thread_link = Html_thread.new_thread_link_el t_s in
+    let new_thread_link = Html_util.new_thread_link_el t_s in
     let return_link = El.a ~at:[ href (to_path Home) ] [ el_txt "Return" ] in
     let navigation_div =
       El.div
         ~at:[ class' "home-left-navigation-div" ]
         [ new_thread_link; return_link ]
     in
-    let mode k = S.map (is_page_kind k) t_s in
+    def_visibility_when_page [ New_thread ] `On new_thread_view t_s;
-    def_on (mode New_thread) new_thread_view;
+    def_visibility_when_page [ Thread ] `Off navigation_div t_s;
-    def_off (mode Thread) navigation_div;
+    def_visibility_when_page [ Thread ] `On thread_view t_s;
-    def_on (mode Thread) thread_view;
+    def_visibility_when_page [ New_thread ] `On return_link t_s;
-    def_off (mode New_thread) new_thread_link;
+    (* done in new_thread_link_el fun
-    def_on (mode New_thread) return_link;
+       def_visibility_when_page [ New_thread ] `Off new_thread_link t_s;*)
     let el =
       El.div
         ~at:[ class' "home-left" ]
@@ -88,13 +88,7 @@ module Home = struct
     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_on
+    def_visibility_when_page [ Home; New_thread; Thread ] `On el t_s;
-      (S.map
-         (fun t ->
-           is_page_kind Home t || is_page_kind New_thread t
-           || is_page_kind Thread t )
-         t_s )
-      el;
     el
 end
 
@@ -311,7 +305,8 @@ module Error_popup = struct
   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);
-    def_off (S.map (fun t -> Option.is_none t.error) t_s) el;
+    let is_error = S.map (fun t -> Option.is_some t.error) t_s in
+    def_visibility `On is_error el;
     el
 end
 

src/client/html_form.ml

@@ -156,7 +156,7 @@ let mk_image_div t_s =
   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_on has_file alt;
+    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

src/client/html_post.ml

@@ -144,7 +144,7 @@ let post_menu t_s post =
            | None -> false
            | Some u -> String.equal u.user_id post.poster_id )
     in
-    def_on own_post delete;
+    def_visibility `On own_post delete;
     [ delete; report ]
   in
   Html_util.mk_dropdown_menu ~class_prefix:"post-info" ~label:""

src/client/html_thread.ml

@@ -53,22 +53,8 @@ let reply_popup_el t_s w =
   in
   let el = El.div ~at:[ class' "reply-popup" ] [ dragzone; content ] in
   Html_form.Dragzone.f ~dragzone el;
-  let is_visible_s = S.map (fun t -> t.post_form.is_open) t_s in
+  let is_open = S.map (fun t -> t.post_form.is_open) t_s in
-  def_on is_visible_s el;
+  def_visibility `On is_open el;
-  el
-
-let new_thread_link_el t_s =
-  let mk user =
-    match user with
-    | None ->
-      (* TODO redirect *)
-      mk_page_link ~label:"Login to post a thread!" Login
-    | Some _user ->
-      El.a ~at:[ href (Page.to_path New_thread) ] [ el_txt "New thread" ]
-  in
-  let el = El.div ~at:[ class' "new-thread-link-div" ] [] in
-  let children = S.map get_user t_s |> S.map (fun u -> [ mk u ]) in
-  Elr.def_children el children;
   el
 
 let bump_status_el v =
@@ -128,7 +114,7 @@ let nav_el kind t_s w =
   in
   let el =
     El.div ~at
-      [ new_thread_link_el t_s
+      [ Html_util.new_thread_link_el t_s
       ; reply_btn_el t_s w
       ; update_el
       ; El.a

src/client/html_util.ml

@@ -1,5 +1,6 @@
 open Brr
 open Note
+open Note_brr
 open Model
 open Util
 
@@ -24,13 +25,18 @@ let mk_page_link ?label p =
 
 let is_page_kind k t = Page.(Kind.equal k (to_kind t.page))
 
+let def_visibility_when_page page_kind_l (visibility : [ `On | `Off ]) el t_s =
+  let b_s =
+    S.map (fun t -> List.exists (fun k -> is_page_kind k t) page_kind_l) t_s
+  in
+  def_visibility visibility b_s el
+
 let mk_page kind t_s l =
   let el =
     let at = [ Fmt.kstr class' "%s-page" (Page.Kind.to_string kind) ] in
     El.div ~at l
   in
-  let is_on = S.map (is_page_kind kind) t_s in
+  def_visibility_when_page [ kind ] `On el t_s;
-  def_on is_on el;
   el
 
 let insert_br s =
@@ -78,3 +84,18 @@ let mk_dropdown_menu ~class_prefix ~label ~at_title ~placeholder mk_content =
     @ [ mk_dropdown_content ""; mk_btn "-close-btn" ]
   in
   El.div ~at l
+
+let new_thread_link_el t_s =
+  let mk user =
+    match user with
+    | None ->
+      (* TODO redirect *)
+      mk_page_link ~label:"Login to post a thread!" Login
+    | Some _user ->
+      El.a ~at:[ href (Page.to_path New_thread) ] [ el_txt "New thread" ]
+  in
+  let el = El.div ~at:[ class' "new-thread-link-div" ] [] in
+  def_visibility_when_page [ New_thread ] `Off el t_s;
+  let children = S.map get_user t_s |> S.map (fun u -> [ mk u ]) in
+  Elr.def_children el children;
+  el

src/client/leaflet_map.ml

@@ -7,12 +7,6 @@ let geoloc_btn =
   let s = "geolocalize-btn" in
   El.button ~at:[ class' s; id s ] [ el_txt "Geolocalize me" ]
 
-let buttons =
-  let new_thread_link =
-    El.a ~at:[ href (Page.to_path New_thread) ] [ el_txt "New thread" ]
-  in
-  El.div ~at:[ class' "map-btn-div" ] [ new_thread_link; geoloc_btn ]
-
 let map_el = El.div ~at:[ id "map" ] []
 
 let map = Map.create_from_div map_el
@@ -178,6 +172,14 @@ module Markers = struct
         set_layer layer
 end
 
+let mk t_s =
+  let buttons =
+    El.div
+      ~at:[ class' "map-btn-div" ]
+      [ Html_util.new_thread_link_el t_s; geoloc_btn ]
+  in
+  [ map_el; buttons ]
+
 let f t_s =
   let open Model in
   S.map (fun t -> t.post_form.latlng) t_s
@@ -195,5 +197,6 @@ let f t_s =
   |> hold_endless (fun id_opt ->
          Markers.select id_opt;
          Markers.refresh (S.value t_s).catalog );
-  let el = El.div ~at:[ class' "home-right" ] [ map_el; buttons ] in
+  let children = mk t_s in
+  let el = El.div ~at:[ class' "home-right" ] children in
   el

src/client/util.ml

@@ -63,9 +63,10 @@ let clamp ~min ~max x = Float.max (Float.min max x) min
 open Note
 open Note_brr
 
-let def_off b_s el = Elr.def_class (str "off") b_s el
+let def_visibility (visibility : [ `On | `Off ]) b_s el =
-
+  match visibility with
-let def_on b_s el = Elr.def_class (str "off") (S.map not b_s) el
+  | `On -> Elr.def_class (str "off") (S.map not b_s) el
+  | `Off -> Elr.def_class (str "off") b_s el
 
 let def_disabled b_s el =
   Elr.def_at At.Name.disabled