brr

src/babillard_page.eml.html

@@ -6,7 +6,7 @@ let f request =
 %   {|<a class="btn btn-primary" id="new-thread-button-redirect" href="/login?redirect=%s">New Thread</a>|} (Dream.to_percent_encoded "/")
 %   else {|<button class="btn btn-primary on" id="new-thread-button">New Thread</button>|}
 % in
-  <script type="text/javascript" src="/assets/js/js_babillard.js" defer="defer"></script>
+  <script type="text/javascript" src="/assets/js/babillard.js" defer="defer"></script>
   <h1>Babillard is love ❤️</h1>
   <br />
   <div class="row mb-3">
@@ -43,8 +43,8 @@ let f request =
             <label for="file" id="file-label" class="form-label">Picture:</label>
             <input id="file" name="file" aria-describedby="file-label" type="file" accept="image/png,image/jpeg,image/webp,image/gif">
             <br />
-            <label for="alt" id="alt-label" class="form-label">Image description:</label>
+            <label for="alt" id="alt-label" class="form-label off">Image description:</label>
-            <input name="alt" type="text" class="form-control" id="alt" aria-labelledby="alt-label" />
+            <input name="alt" type="text" class="form-control off" id="alt" aria-labelledby="alt-label" />
             <br />
             <button type="submit" class="btn btn-primary" id="submit-new-thread-button" disabled>Make Thread</button>
           </form>

src/catalog_page.eml.html

@@ -1,6 +1,6 @@
 let f content =
 
-<script type="text/javascript" src="/assets/js/js_catalog.js" defer="defer"></script>
+<script type="text/javascript" src="/assets/js/catalog.js" defer="defer"></script>
   <h1>Catalog:</h1>
   <br />
   <div class="row mb-3">

src/content/assets/css/style.css

@@ -118,14 +118,6 @@ blockquote.blockquote {
   visibility: hidden;
 }
 
-#alt-label {
-  display:none;
-}
-
-#alt {
-  display:none;
-}
-
 a.preview-link {
   text-decoration: none;
   color: unset;

src/content/assets/js/dune

@@ -1,26 +1,26 @@
 (rule
- (target js_catalog.js)
+ (target catalog.js)
  (deps
-  (file ../../../js/js_catalog.bc.js))
+  (file ../../../js/catalog.bc.js))
  (action
   (with-stdout-to
    %{target}
-   (cat ../../../js/js_catalog.bc.js))))
+   (cat ../../../js/catalog.bc.js))))
 
 (rule
- (target js_babillard.js)
+ (target babillard.js)
  (deps
-  (file ../../../js/js_babillard.bc.js))
+  (file ../../../js/babillard.bc.js))
  (action
   (with-stdout-to
    %{target}
-   (cat ../../../js/js_babillard.bc.js))))
+   (cat ../../../js/babillard.bc.js))))
 
 (rule
- (target js_thread.js)
+ (target thread.js)
  (deps
-  (file ../../../js/js_thread.bc.js))
+  (file ../../../js/thread.bc.js))
  (action
   (with-stdout-to
    %{target}
-   (cat ../../../js/js_thread.bc.js))))
+   (cat ../../../js/thread.bc.js))))

src/delete_page.eml.html

@@ -1,6 +1,6 @@
 let f post_preview post_id request =
 
-<script type="text/javascript" src="/assets/js/js_catalog.js" defer="defer"></script>
+<script type="text/javascript" src="/assets/js/catalog.js" defer="defer"></script>
       <%s! post_preview %>
 % let url = Format.sprintf "/delete/%s" post_id in
 % begin match Dream.session "nick" request with

src/dune

@@ -111,9 +111,9 @@
  (target content.ml)
  (deps
   (source_tree content)
-  (file content/assets/js/js_babillard.js)
+  (file content/assets/js/babillard.js)
-  (file content/assets/js/js_catalog.js)
+  (file content/assets/js/catalog.js)
-  (file content/assets/js/js_thread.js))
+  (file content/assets/js/thread.js))
  (action
   (with-stdout-to
    %{null}

src/js/babillard.ml

@@ -1,29 +1,26 @@
-open Js_map
+open Brr
-include Js_post_form
+open Utils
+open Map
 
 module Visibility = struct
-  let new_thread_div = Jv.get Jv.global "new-thread"
+  let new_thread_div = find_by_id "new-thread"
 
-  let thread_preview_div = Jv.get Jv.global "thread-preview"
+  let thread_preview_div = find_by_id "thread-preview"
 
-  let return_button = Jv.get Jv.global "return-button"
+  let return_button = find_by_id "return-button"
 
   (* new-thread-button is new-thread-button-redirect if not logged in *)
-  let new_thread_button = Jv.find Jv.global "new-thread-button"
+  let new_thread_button = find_by_id_opt "new-thread-button"
 
   let is_in_new_thread_mode = ref false
 
   let set_visible el =
     log "set_visible@\n";
-    let class_list = Jv.get el "classList" in
+    El.set_class (Jstr.of_string "off") false el
-    ignore
-    @@ Jv.call class_list "replace" [| Jv.of_string "off"; Jv.of_string "on" |]
 
   let set_invisible el =
     log "set_invisible@\n";
-    let class_list = Jv.get el "classList" in
+    El.set_class (Jstr.of_string "off") true el
-    ignore
-    @@ Jv.call class_list "replace" [| Jv.of_string "on"; Jv.of_string "off" |]
 
   let to_new_thread_mode _event =
     log "change_page_mode@\n";
@@ -45,32 +42,32 @@ module Visibility = struct
 
   let () =
     log "add events on return/new thread button@\n";
-    ignore
+    let (_ : Ev.listener) =
-    @@ Jv.call return_button "addEventListener"
+      Ev.listen Ev.click to_babillard_mode (El.as_target return_button)
-         [| Jv.of_string "click"; Jv.repr to_babillard_mode |];
+    in
     Option.iter
       (fun button ->
-        ignore
+        let (_ : Ev.listener) =
-        @@ Jv.call button "addEventListener"
+          Ev.listen Ev.click to_new_thread_mode (El.as_target button)
-             [| Jv.of_string "click"; Jv.repr to_new_thread_mode |] )
+        in
+        () )
       new_thread_button
 end
 
 module Marker = struct
-  let window = Jv.get Jv.global "window"
+  let thread_preview_div = find_by_id "thread-preview"
-
-  let thread_preview_div = Jv.get Jv.global "thread-preview"
 
   let marker_on_click thread_preview _e =
     log "marker_on_click@\n";
-    if not !Visibility.is_in_new_thread_mode then
+    if not !Visibility.is_in_new_thread_mode then (
-      ignore @@ Jv.set thread_preview_div "innerHTML" thread_preview;
+      let inner_html = El.Prop.jstr (Jstr.of_string "innerHTML") in
-    Js_pretty_post.make_pretty ()
+      El.set_prop inner_html thread_preview thread_preview_div;
+      Pretty_post.make_pretty () )
 
   let on_each_feature feature layer =
     log "on_each_feature@\n";
     let feature_properties = Jv.get feature "properties" in
-    let thread_preview = Jv.get feature_properties "content" in
+    let thread_preview = Jv.get feature_properties "content" |> Jv.to_jstr in
     Leaflet.Layer.on Leaflet.Event.Click (marker_on_click thread_preview) layer
 
   let handle_geojson geojson =
@@ -89,15 +86,17 @@ module Marker = struct
   let () =
     log "fetch thread geojson@\n";
     let link = Jv.of_string "/markers" in
+    (* todo: fetch with Brr *)
+    let window = Jv.get Jv.global "window" in
     let fetchfutur = Jv.call window "fetch" [| link |] in
     ignore @@ Jv.call fetchfutur "then" [| Jv.repr markers_handle_response |]
 end
 
-let lat_input = Jv.get Jv.global "lat-input"
+let lat_input = find_by_id "lat-input"
 
-let lng_input = Jv.get Jv.global "lng-input"
+let lng_input = find_by_id "lng-input"
 
-let button = Jv.get Jv.global "submit-new-thread-button"
+let button = find_by_id "submit-new-thread-button"
 
 (* set input lat/lng when clicked*)
 let on_click_set_latlng e =
@@ -110,12 +109,12 @@ let on_click_set_latlng e =
     in
     Leaflet.Map.open_popup popup map;
 
-    let lat = Leaflet.Latlng.lat latlng |> Jv.of_float in
+    let lat = Leaflet.Latlng.lat latlng |> Jstr.of_float in
-    let lng = Leaflet.Latlng.lng latlng |> Jv.of_float in
+    let lng = Leaflet.Latlng.lng latlng |> Jstr.of_float in
-    ignore @@ Jv.call lat_input "setAttribute" [| Jv.of_string "value"; lat |];
+    let value_jstr = Jstr.of_string "value" in
-    ignore @@ Jv.call lng_input "setAttribute" [| Jv.of_string "value"; lng |];
+    El.set_at value_jstr (Some lat) lat_input;
-
+    El.set_at value_jstr (Some lng) lng_input;
-    ignore @@ Jv.call button "removeAttribute" [| Jv.of_string "disabled" |] )
+    El.set_at (Jstr.of_string "disabled") None button )
 
 (*add on_click callback to map*)
 let () = Leaflet.Map.on Leaflet.Event.Click on_click_set_latlng map

src/js/dune

@@ -1,46 +1,53 @@
 (library
- (name js_post_form)
+ (name utils)
- (modules js_post_form)
+ (modules utils)
- (libraries js_of_ocaml brr)
+ (libraries brr)
  (preprocess
   (pps js_of_ocaml-ppx)))
 
 (library
- (name js_pretty_post)
+ (name post_form)
- (modules js_pretty_post)
+ (modules post_form)
- (libraries js_of_ocaml brr unix)
+ (libraries js_of_ocaml brr utils)
  (preprocess
   (pps js_of_ocaml-ppx)))
 
 (library
- (name js_map)
+ (name pretty_post)
- (modules js_map)
+ (modules pretty_post)
- (libraries js_of_ocaml brr leaflet)
+ (libraries js_of_ocaml brr unix utils)
+ (preprocess
+  (pps js_of_ocaml-ppx)))
+
+(library
+ (name map)
+ (modules map)
+ (libraries js_of_ocaml brr leaflet utils)
  (js_of_ocaml
   (javascript_files leaflet/leaflet.js))
  (preprocess
   (pps js_of_ocaml-ppx)))
 
 (executable
- (name js_catalog)
+ (name catalog)
- (modules js_catalog)
+ (modules catalog)
- (libraries js_of_ocaml brr js_pretty_post)
+ (libraries js_of_ocaml brr pretty_post)
  (modes js)
  (preprocess
   (pps js_of_ocaml-ppx)))
 
 (executable
- (name js_babillard)
+ (name babillard)
- (modules js_babillard)
+ (modules babillard)
- (libraries js_of_ocaml brr js_map js_post_form js_pretty_post leaflet)
+ (libraries js_of_ocaml brr map post_form pretty_post leaflet utils)
  (modes js)
  (preprocess
   (pps js_of_ocaml-ppx)))
 
 (executable
- (name js_thread)
+ (name thread)
- (modules js_thread)
+ (modules thread)
- (libraries js_of_ocaml brr js_post_form js_pretty_post)
+ (libraries js_of_ocaml brr post_form pretty_post)
  (modes js)
  (preprocess
   (pps js_of_ocaml-ppx)))

src/js/js_catalog.ml

@@ -1 +0,0 @@
-include Js_pretty_post

src/js/js_post_form.ml

@@ -1,55 +0,0 @@
-let log = Format.printf
-
-(* called by clicking post_id *)
-(* insert emojid into reply form *)
-let insert_quote emojid _event =
-  log "quote@\n";
-  Option.iter
-    (fun textarea ->
-      let content = Jv.to_string @@ Jv.get textarea "value" in
-      let new_content =
-        if String.ends_with ~suffix:"\n" content || String.length content = 0
-        then (* don't skip a line *)
-          Format.sprintf "%s[%s] " content emojid
-        else Format.sprintf "%s@\n[%s] " content emojid
-      in
-      ignore @@ Jv.set textarea "value" (Jv.of_string new_content) )
-    Jv.(find global "reply-comment")
-
-let () =
-  log "add inser_quote event on post links@\n";
-  let document = Jv.get Jv.global "document" in
-  let quote_links =
-    Jv.to_jv_list
-    @@ Jv.call document "getElementsByClassName" [| Jv.of_string "quote-link" |]
-  in
-  log "quote_links leng %d@\n" (List.length quote_links);
-  let add_click quote_link =
-    let emojid =
-      Jv.to_string
-      @@ Jv.call quote_link "getAttribute" [| Jv.of_string "data-emojid" |]
-    in
-    ignore
-    @@ Jv.call quote_link "addEventListener"
-         [| Jv.of_string "click"; Jv.repr (insert_quote emojid) |]
-  in
-  List.iter add_click quote_links
-
-(* make image description field visible when a file is selected*)
-let make_visible el _event =
-  let el_style = Jv.get el "style" in
-  ignore @@ Jv.set el_style "display" (Jv.of_string "block")
-
-let () =
-  log "change image description visibility@\n";
-  Option.iter
-    (fun file_input ->
-      let alt_input = Jv.get Jv.global "alt" in
-      let alt_label = Jv.get Jv.global "alt-label" in
-      ignore
-      @@ Jv.call file_input "addEventListener"
-           [| Jv.of_string "change"; Jv.repr (make_visible alt_input) |];
-      ignore
-      @@ Jv.call file_input "addEventListener"
-           [| Jv.of_string "change"; Jv.repr (make_visible alt_label) |] )
-    Jv.(find global "file")

src/js/js_thread.ml

@@ -1,2 +0,0 @@
-include Js_post_form
-include Js_pretty_post

src/js/map.ml

@@ -1,4 +1,4 @@
-let log = Format.printf
+open Utils
 
 let map = Leaflet.Map.create_on "map"
 
@@ -53,8 +53,7 @@ let on_zoomend _event =
   log "on zoomend event@\n";
   let zoom = Leaflet.Map.get_zoom map in
   match
-    Brr_io.Storage.set_item storage (Jstr.of_string "zoom")
+    Brr_io.Storage.set_item storage (Jstr.of_string "zoom") (Jstr.of_int zoom)
-      (Jv.to_jstr @@ Jv.of_int zoom)
   with
   | (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage"
   | Ok () -> ()
@@ -81,8 +80,9 @@ module Geolocalize = struct
     ignore @@ Fut.await (Brr_io.Geolocation.get l) update_location
 
   let () =
-    let button = Jv.get Jv.global "geolocalize" in
+    let button = find_by_id "geolocalize" in
-    ignore
+    let (_ : Brr.Ev.listener) =
-    @@ Jv.call button "addEventListener"
+      Brr.Ev.listen Brr.Ev.click geolocalize (Brr.El.as_target button)
-         [| Jv.of_string "click"; Jv.repr geolocalize |]
+    in
+    ()
 end

src/js/post_form.ml

@@ -0,0 +1,45 @@
+open Brr
+open Utils
+
+(* called by clicking post_id *)
+(* insert emojid into reply form *)
+let insert_quote el _event =
+  log "quote@\n";
+  let emojid =
+    match El.at (Jstr.of_string "data-emojid") el with
+    | None -> "no data-emojid on element"
+    | Some emojid -> Jstr.to_string emojid
+  in
+  let textarea = find_by_id "reply-comment" in
+  let inner_html = El.Prop.jstr (Jstr.of_string "innerHTML") in
+  let content = Jstr.to_string @@ El.prop inner_html textarea in
+  let new_content =
+    if String.ends_with ~suffix:"\n" content || String.length content = 0 then
+      (* don't skip a line *)
+      Format.sprintf "%s[>%s] " content emojid
+    else Format.sprintf "%s@\n[>%s] " content emojid
+  in
+  El.set_prop inner_html (Jstr.of_string new_content) textarea
+
+let () =
+  log "add inser_quote event on post links@\n";
+  add_event_to_class Ev.click "quote-link" insert_quote
+
+(* make image description field visible when a file is selected*)
+let make_visible el _event = El.set_class (Jstr.of_string "off") false el
+
+let () =
+  log "add event to change image description visibility@\n";
+  match find_by_id_opt "file" with
+  | None -> log "no file element found, not logged in?@\n"
+  | Some file_input ->
+    let alt_input = find_by_id "alt" in
+    let alt_label = find_by_id "alt-label" in
+    let change = Ev.Type.create (Jstr.of_string "change") in
+    let (_ : Ev.listener) =
+      Ev.listen change (make_visible alt_input) (El.as_target file_input)
+    in
+    let (_ : Ev.listener) =
+      Ev.listen change (make_visible alt_label) (El.as_target file_input)
+    in
+    ()

src/js/pretty_post.ml

@@ -1,6 +1,5 @@
 open Brr
-
+open Utils
-let log = Format.printf
 
 type image_size =
   | Big
@@ -50,12 +49,6 @@ let render_time date_span =
     | None -> failwith "no attribute data-time for date element"
     | Some data_time -> Jstr.to_float data_time
   in
-  (*
-     let t =
-       Jv.to_float
-         (Jv.call date_span "getAttribute" [| Jv.of_string "data-time" |])
-     in
-  *)
   let t = Unix.localtime data_time in
   let date =
     Format.sprintf "%02d-%02d-%02d %02d:%02d" (1900 + t.tm_year) (1 + t.tm_mon)
@@ -75,7 +68,7 @@ let on_hashchange _event =
   let frag = Jstr.to_string @@ Uri.fragment @@ Window.location G.window in
   if frag = "" then ()
   else
-    match Document.find_el_by_id G.document (Jstr.of_string frag) with
+    match find_by_id_opt frag with
     | None -> log "fragment not found on the page"
     | Some reply ->
       let () =
@@ -110,9 +103,7 @@ let clone_element el =
   let body = Jv.get document "body" in
   ignore @@ Jv.call body "append" [| div |];
   (* go back to El *)
-  match
+  match find_by_id_opt "floating-reply-preview" with
-    Document.find_el_by_id G.document (Jstr.of_string "floating-reply-preview")
-  with
   | None -> failwith "error cloning element"
   | Some el -> el
 
@@ -122,15 +113,17 @@ let on_mouse_over el _event =
   let reply_id =
     match El.at (Jstr.of_string "data-id") el with
     | None -> failwith "no data-id on element"
-    | Some data_id -> data_id
+    | Some data_id -> Jstr.to_string data_id
   in
 
-  match Document.find_el_by_id G.document reply_id with
+  match find_by_id_opt reply_id with
   | None -> failwith "error getting reply_div, this reply is not on this page"
   | Some reply_div ->
     (* check if it in view, if it is, just make it of class `highlight` *)
+    let window_height =
       let window = Jv.get Jv.global "window" in
-    let window_height = Jv.get window "innerHeight" |> Jv.to_int in
+      Jv.get window "innerHeight" |> Jv.to_int
+    in
     let reply_top = El.bound_y reply_div |> int_of_float in
     if reply_top < window_height - 50 && reply_top + 50 > 0 then (
       (* just highlight if reply is in viewport *)
@@ -184,30 +177,21 @@ let on_mouse_out _el _event =
 let make_pretty _event =
   log "make pretty@\n";
 
-  let add_event_to_class ~name ~event handler =
-    let event = Ev.Type.create (Jstr.of_string event) in
-    let el_list = El.find_by_class (Jstr.of_string name) in
-    List.iter (fun el -> Ev.listen event (handler el) (El.as_target el)) el_list
-  in
-
   let dates = El.find_by_class (Jstr.of_string "date") in
   List.iter render_time dates;
 
   (*add event image_click to all postImage*)
-  let () = add_event_to_class ~name:"post-image" ~event:"click" image_click in
+  let () = add_event_to_class Ev.click "post-image" image_click in
 
   (*add event mouse_over/out to all reply-link *)
-  let () =
+  let () = add_event_to_class Ev.mouseover "reply-link" on_mouse_over in
-    add_event_to_class ~name:"reply-link" ~event:"mouseover" on_mouse_over
+  let () = add_event_to_class Ev.mouseout "reply-link" on_mouse_out in
-  in
-  let () =
-    add_event_to_class ~name:"reply-link" ~event:"mouseout" on_mouse_out
-  in
 
   (* add fragment listener to mark as selected the linked post *)
-  (* TODO call with brr*)
   let hashchange = Ev.Type.create (Jstr.of_string "hashchange") in
-  Ev.listen hashchange on_hashchange (Window.as_target G.window);
+  let (_ : Ev.listener) =
+    Ev.listen hashchange on_hashchange (Window.as_target G.window)
+  in
   (* call hashchange on page load too *)
   on_hashchange ()
 
@@ -215,6 +199,7 @@ let make_pretty _event =
 let () =
   log "add load eventlistener to make pretty@\n";
   let load = Ev.Type.create (Jstr.of_string "load") in
+  let (_ : Ev.listener) =
     Ev.listen load make_pretty (Window.as_target G.window)
-
+  in
-(* TODO reply can be in another thread, how to display it? if displaying it on mouseover we need to fetch it. and display it in special color. need to change pp_post in pp_babillard *)
+  ()

src/js/utils.ml

@@ -0,0 +1,18 @@
+open Brr
+
+let log = Format.printf
+
+let find_by_id_opt id = Document.find_el_by_id G.document (Jstr.of_string id)
+
+let find_by_id id =
+  match find_by_id_opt id with
+  | None -> failwith (Format.sprintf "element `%s` not found" id)
+  | Some el -> el
+
+let add_event_to_class event name handler =
+  let el_list = El.find_by_class (Jstr.of_string name) in
+  List.iter
+    (fun el ->
+      let (_ : Ev.listener) = Ev.listen event (handler el) (El.as_target el) in
+      () )
+    el_list

src/report_page.eml.html

@@ -1,6 +1,6 @@
 let f post_preview post_id request =
 
-<script type="text/javascript" src="/assets/js/js_catalog.js" defer="defer"></script>
+<script type="text/javascript" src="/assets/js/catalog.js" defer="defer"></script>
       <%s! post_preview %>
 % let url = Format.sprintf "/report/%s" post_id in
 % begin match Dream.session "nick" request with

src/thread_page.eml.html

@@ -1,5 +1,5 @@
 let f thread_view thread_id request =
-<script type="text/javascript" src="/assets/js/js_thread.js" defer="defer"></script>
+<script type="text/javascript" src="/assets/js/thread.js" defer="defer"></script>
       <%s! thread_view %>
 % let thread_url = Format.sprintf "/thread/%s" thread_id in
 % begin match Dream.session "nick" request with