diff --git a/src/client/html.ml b/src/client/html.ml
index 4860e2d..d48b4da 100644
--- a/src/client/html.ml
+++ b/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_on (mode New_thread) new_thread_view;
- def_off (mode Thread) navigation_div;
- def_on (mode Thread) thread_view;
- def_off (mode New_thread) new_thread_link;
- def_on (mode New_thread) return_link;
+ def_visibility_when_page [ New_thread ] `On new_thread_view t_s;
+ def_visibility_when_page [ Thread ] `Off navigation_div t_s;
+ def_visibility_when_page [ Thread ] `On thread_view t_s;
+ def_visibility_when_page [ New_thread ] `On return_link t_s;
+ (* done in new_thread_link_el fun
+ 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
- (S.map
- (fun t ->
- is_page_kind Home t || is_page_kind New_thread t
- || is_page_kind Thread t )
- t_s )
- el;
+ def_visibility_when_page [ Home; New_thread; Thread ] `On el t_s;
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
diff --git a/src/client/html_form.ml b/src/client/html_form.ml
index a9578eb..a8b822e 100644
--- a/src/client/html_form.ml
+++ b/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
diff --git a/src/client/html_post.ml b/src/client/html_post.ml
index 23c9e21..9c11a93 100644
--- a/src/client/html_post.ml
+++ b/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:""
diff --git a/src/client/html_thread.ml b/src/client/html_thread.ml
index 205e40c..d104938 100644
--- a/src/client/html_thread.ml
+++ b/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
- def_on is_visible_s 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;
+ let is_open = S.map (fun t -> t.post_form.is_open) t_s in
+ def_visibility `On is_open el;
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
diff --git a/src/client/html_util.ml b/src/client/html_util.ml
index 4135605..1c56ea3 100644
--- a/src/client/html_util.ml
+++ b/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_on is_on el;
+ def_visibility_when_page [ kind ] `On el t_s;
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
diff --git a/src/client/leaflet_map.ml b/src/client/leaflet_map.ml
index 1d33cd7..a05558c 100644
--- a/src/client/leaflet_map.ml
+++ b/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
diff --git a/src/client/util.ml b/src/client/util.ml
index 252208d..d0a3283 100644
--- a/src/client/util.ml
+++ b/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_on b_s el = Elr.def_class (str "off") (S.map not b_s) el
+let def_visibility (visibility : [ `On | `Off ]) b_s el =
+ match visibility with
+ | `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